path: root/ghc/compiler/iface/LoadIface.lhs

%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section{Dealing with interface files}

\begin{code}
module LoadIface (
	loadHomeInterface, loadInterface,
	loadSrcInterface, loadOrphanModules, loadHiBootInterface,
	readIface,	-- Used when reading the module's old interface
	predInstGates, ifaceInstGates, ifaceStats, discardDeclPrags,
	initExternalPackageState,
	noIfaceErr,   -- used by CompManager too
   ) where

#include "HsVersions.h"

import {-# SOURCE #-}	TcIface( tcIfaceDecl )

import Packages		( PackageState(..), isHomeModule  )
import DriverState	( v_GhcMode, isCompManagerMode )
import DriverUtil	( replaceFilenameSuffix )
import CmdLineOpts	( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ) )
import Parser		( parseIface )

import IfaceSyn		( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..),
			  IfaceConDecls(..), IfaceInst(..), IfaceRule(..),
			  IfaceExpr(..), IfaceTyCon(..), IfaceIdInfo(..), 
			  IfaceType(..), IfacePredType(..), IfaceExtName,
			  mkIfaceExtName )
import IfaceEnv		( newGlobalBinder, lookupIfaceExt, lookupIfaceTc,
			  lookupOrig )
import HscTypes		( ModIface(..), TyThing, emptyModIface, EpsStats(..),
			  addEpsInStats, ExternalPackageState(..),
			  PackageTypeEnv, emptyTypeEnv,  IfacePackage(..),
			  lookupIfaceByModule, emptyPackageIfaceTable,
			  IsBootInterface, mkIfaceFixCache, Gated,
			  implicitTyThings, addRulesToPool, addInstsToPool,
			  availNames
			 )

import BasicTypes	( Version, Fixity(..), FixityDirection(..),
			  isMarkedStrict )
import TcType		( Type, tcSplitTyConApp_maybe )
import Type		( funTyCon )
import TcRnMonad

import PrelNames	( gHC_PRIM )
import PrelInfo		( ghcPrimExports )
import PrelRules	( builtinRules )
import Rules		( emptyRuleBase )
import InstEnv		( emptyInstEnv )
import Name		( Name {-instance NamedThing-}, getOccName,
			  nameModule, isInternalName )
import NameEnv
import MkId		( seqId )
import Module		( Module, ModLocation(ml_hi_file), emptyModuleEnv, 
			  extendModuleEnv, lookupModuleEnv, moduleUserString
			)
import OccName		( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc, mkClassDataConOcc,
			  mkSuperDictSelOcc, mkDataConWrapperOcc, mkDataConWorkerOcc )
import Class		( Class, className )
import TyCon		( tyConName )
import SrcLoc		( mkSrcLoc, importedSrcLoc )
import Maybes		( isJust, mapCatMaybes )
import StringBuffer     ( hGetStringBuffer )
import FastString	( mkFastString )
import ErrUtils         ( Message, mkLocMessage )
import Finder		( findModule, findPackageModule,  FindResult(..),
			  hiBootExt, hiBootVerExt )
import Lexer
import Outputable
import BinIface		( readBinIface )
import Panic
import List		( nub )

import DATA_IOREF	( readIORef )

import Directory
\end{code}


%************************************************************************
%*									*
		loadSrcInterface, loadOrphanModules

		These two are called from TcM-land	
%*									*
%************************************************************************

\begin{code}
loadSrcInterface :: SDoc -> Module -> IsBootInterface -> RnM ModIface
-- This is called for each 'import' declaration in the source code
-- On a failure, fail in the monad with an error message

loadSrcInterface doc mod_name want_boot
  = do 	{ mb_iface <- initIfaceTcRn $ loadInterface doc mod_name 
					   (ImportByUser want_boot)
	; case mb_iface of
	    Left err    -> failWithTc (elaborate err) 
	    Right iface -> return iface
	}
  where
    elaborate err = hang (ptext SLIT("Failed to load interface for") <+> 
			 quotes (ppr mod_name) <> colon) 4 err

loadHiBootInterface :: TcRn [Name]
-- Load the hi-boot iface for the module being compiled,
-- if it indeed exists in the transitive closure of imports
-- Return the list of names exported by the hi-boot file
loadHiBootInterface
  = do 	{ eps <- getEps
	; mod <- getModule

	; traceIf (text "loadHiBootInterface" <+> ppr mod)

	-- We're read all the direct imports by now, so eps_is_boot will
	-- record if any of our imports mention us by way of hi-boot file
	; case lookupModuleEnv (eps_is_boot eps) mod of {
	    Nothing             -> return [] ;	-- The typical case

	    Just (_, False) -> 		-- Someone below us imported us!
		-- This is a loop with no hi-boot in the way
		failWithTc (moduleLoop mod) ;

	    Just (mod_nm, True) -> 	-- There's a hi-boot interface below us
		

    do	{ 	-- Load it (into the PTE, and return the exported names
	  iface <- loadSrcInterface (mk_doc mod_nm) mod_nm True
	; sequenceM [ lookupOrig mod_nm occ
		    | (mod,avails) <- mi_exports iface, 
		      avail <- avails, occ <- availNames avail]
    }}}
  where
    mk_doc mod = ptext SLIT("Need the hi-boot interface for") <+> ppr mod
		 <+> ptext SLIT("to compare against the Real Thing")

    moduleLoop mod = ptext SLIT("Circular imports: module") <+> quotes (ppr mod) 
		     <+> ptext SLIT("depends on itself")

loadOrphanModules :: [Module] -> TcM ()
loadOrphanModules mods
  | null mods = returnM ()
  | otherwise = initIfaceTcRn $
		do { traceIf (text "Loading orphan modules:" <+> 
		     		 fsep (map ppr mods))
		   ; mappM_ load mods
		   ; returnM () }
  where
    load mod   = loadSysInterface (mk_doc mod) mod
    mk_doc mod = ppr mod <+> ptext SLIT("is a orphan-instance module")
\end{code}

%*********************************************************
%*							*
		loadHomeInterface
		Called from Iface-land
%*							*
%*********************************************************

\begin{code}
loadHomeInterface :: SDoc -> Name -> IfM lcl ModIface
loadHomeInterface doc name
  = ASSERT2( not (isInternalName name), ppr name <+> parens doc )
    loadSysInterface doc (nameModule name)

loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
-- A wrapper for loadInterface that Throws an exception if it fails
loadSysInterface doc mod_name
  = do	{ mb_iface <- loadInterface doc mod_name ImportBySystem
	; case mb_iface of 
	    Left err    -> ghcError (ProgramError (showSDoc err))
	    Right iface -> return iface }
\end{code}


%*********************************************************
%*							*
		loadInterface

	The main function to load an interface
	for an imported module, and put it in
	the External Package State
%*							*
%*********************************************************

\begin{code}
loadInterface :: SDoc -> Module -> WhereFrom 
	      -> IfM lcl (Either Message ModIface)
-- If it can't find a suitable interface file, we
--	a) modify the PackageIfaceTable to have an empty entry
--		(to avoid repeated complaints)
--	b) return (Left message)
--
-- It's not necessarily an error for there not to be an interface
-- file -- perhaps the module has changed, and that interface 
-- is no longer used -- but the caller can deal with that by 
-- catching the exception

loadInterface doc_str mod_name from
  = do	{ 	-- Read the state
	  (eps,hpt) <- getEpsAndHpt

	; traceIf (text "Considering whether to load" <+> ppr mod_name <+> ppr from)

		-- Check whether we have the interface already
	; case lookupIfaceByModule hpt (eps_PIT eps) mod_name of {
	    Just iface 
		-> returnM (Right iface) ;	-- Already loaded
			-- The (src_imp == mi_boot iface) test checks that the already-loaded
			-- interface isn't a boot iface.  This can conceivably happen,
			-- if an earlier import had a before we got to real imports.   I think.
	    other -> do

	{ let { hi_boot_file = case from of
				ImportByUser usr_boot -> usr_boot
				ImportBySystem        -> sys_boot

	      ; mb_dep   = lookupModuleEnv (eps_is_boot eps) mod_name
	      ; sys_boot = case mb_dep of
				Just (_, is_boot) -> is_boot
				Nothing		  -> False
			-- The boot-ness of the requested interface, 
	      }		-- based on the dependencies in directly-imported modules

	-- READ THE MODULE IN
	; let explicit | ImportByUser _ <- from = True
		       | otherwise              = False
	; read_result <- findAndReadIface explicit doc_str mod_name hi_boot_file
	; dflags <- getDOpts
	; case read_result of {
	    Left err -> do
	  	{ let fake_iface = emptyModIface ThisPackage mod_name

		; updateEps_ $ \eps ->
			eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
			-- Not found, so add an empty iface to 
			-- the EPS map so that we don't look again
				
		; returnM (Left err) } ;

	-- Found and parsed!
	    Right iface -> 

	let { mod = mi_module iface } in

	-- Sanity check.  If we're system-importing a module we know nothing at all
	-- about, it should be from a different package to this one
	WARN(   case from of { ImportBySystem -> True; other -> False } &&
		not (isJust mb_dep) && 
	 	isHomeModule dflags mod,
		ppr mod $$ ppr mb_dep $$ ppr (eps_is_boot eps) )

	initIfaceLcl mod_name $ do
	-- 	Load the new ModIface into the External Package State
	-- Even home-package interfaces loaded by loadInterface 
	-- 	(which only happens in OneShot mode; in Batch/Interactive 
	--  	mode, home-package modules are loaded one by one into the HPT)
	-- are put in the EPS.
	--
	-- The main thing is to add the ModIface to the PIT, but
	-- we also take the
	--	IfaceDecls, IfaceInst, IfaceRules
	-- out of the ModIface and put them into the big EPS pools

	-- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
	---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
	--     If we do loadExport first the wrong info gets into the cache (unless we
	-- 	explicitly tag each export which seems a bit of a bore)

	{ ignore_prags <- doptM Opt_IgnoreInterfacePragmas
	; new_eps_decls <- loadDecls ignore_prags mod      (mi_decls iface)
	; new_eps_rules <- loadRules ignore_prags mod_name (mi_rules iface)
	; new_eps_insts <- loadInsts              mod_name (mi_insts iface)

	; let {	final_iface = iface {	mi_decls = panic "No mi_decls in PIT",
					mi_insts = panic "No mi_insts in PIT",
					mi_rules = panic "No mi_rules in PIT" } }

	; updateEps_  $ \ eps -> 
		eps {	eps_PIT   = extendModuleEnv (eps_PIT eps) mod final_iface,
			eps_PTE   = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
			eps_rules = addRulesToPool  (eps_rules eps) new_eps_rules,
			eps_insts = addInstsToPool  (eps_insts eps) new_eps_insts,
			eps_stats = addEpsInStats   (eps_stats eps) (length new_eps_decls)
						    (length new_eps_insts) (length new_eps_rules) }

	; return (Right final_iface)
    }}}}}

-----------------------------------------------------
--	Loading type/class/value decls
-- We pass the full Module name here, replete with
-- its package info, so that we can build a Name for
-- each binder with the right package info in it
-- All subsequent lookups, including crucially lookups during typechecking
-- the declaration itself, will find the fully-glorious Name
-----------------------------------------------------

addDeclsToPTE :: PackageTypeEnv -> [[(Name,TyThing)]] -> PackageTypeEnv
addDeclsToPTE pte things = foldl extendNameEnvList pte things

loadDecls :: Bool	-- Don't load pragmas into the decl pool
	  -> Module
	  -> [(Version, IfaceDecl)]
	  -> IfL [[(Name,TyThing)]]	-- The list can be poked eagerly, but the
					-- TyThings are forkM'd thunks
loadDecls ignore_prags mod decls = mapM (loadDecl ignore_prags mod) decls

loadDecl ignore_prags mod (_version, decl)
  = do 	{ 	-- Populate the name cache with final versions of all 
		-- the names associated with the decl
	  main_name      <- mk_new_bndr Nothing (ifName decl)
	; implicit_names <- mapM (mk_new_bndr (Just main_name)) (ifaceDeclSubBndrs decl)

	-- Typecheck the thing, lazily
	; thing <- forkM doc (bumpDeclStats main_name >> tcIfaceDecl stripped_decl)
	; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
	      lookup n = case lookupOccEnv mini_env (getOccName n) of
			   Just thing -> thing
			   Nothing    -> pprPanic "loadDecl" (ppr main_name <+> ppr n)

	; returnM ((main_name, thing) : [(n, lookup n) | n <- implicit_names]) }
		-- We build a list from the *known* names, with (lookup n) thunks
		-- as the TyThings.  That way we can extend the PTE without poking the
		-- thunks
  where
    stripped_decl | ignore_prags = discardDeclPrags decl
		  | otherwise    = decl

	-- mk_new_bndr allocates in the name cache the final canonical
	-- name for the thing, with the correct 
	--	* package info
	--	* parent
	--	* location
	-- imported name, to fix the module correctly in the cache
    mk_new_bndr mb_parent occ = newGlobalBinder mod occ mb_parent loc
    loc = importedSrcLoc (moduleUserString mod)
    doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)

discardDeclPrags :: IfaceDecl -> IfaceDecl
discardDeclPrags decl@(IfaceId {ifIdInfo = HasInfo _}) = decl { ifIdInfo = NoInfo }
discardDeclPrags decl 		    	  	       = decl

bumpDeclStats :: Name -> IfL ()		-- Record that one more declaration has actually been used
bumpDeclStats name
  = do	{ traceIf (text "Loading decl for" <+> ppr name)
	; updateEps_ (\eps -> let stats = eps_stats eps
			      in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
	}

-----------------
ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
-- *Excludes* the 'main' name, but *includes* the implicitly-bound names
-- Deeply revolting, because it has to predict what gets bound,
-- especially the question of whether there's a wrapper for a datacon

ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ, ifSigs = sigs })
  = [tc_occ, dc_occ, dcww_occ] ++
    [op | IfaceClassOp op _ _ <- sigs] ++
    [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] 
  where
    n_ctxt = length sc_ctxt
    n_sigs = length sigs
    tc_occ  = mkClassTyConOcc cls_occ
    dc_occ  = mkClassDataConOcc cls_occ	
    dcww_occ | is_newtype = mkDataConWrapperOcc dc_occ	-- Newtypes have wrapper but no worker
	     | otherwise  = mkDataConWorkerOcc dc_occ	-- Otherwise worker but no wrapper
    is_newtype = n_sigs + n_ctxt == 1			-- Sigh 

ifaceDeclSubBndrs (IfaceData {ifCons = IfAbstractTyCon}) 
  = []
-- Newtype
ifaceDeclSubBndrs (IfaceData {ifCons = IfNewTyCon (IfVanillaCon { ifConOcc = con_occ, 
								  ifConFields = fields})}) 
  = fields ++ [con_occ, mkDataConWrapperOcc con_occ] 	
	-- Wrapper, no worker; see MkId.mkDataConIds

ifaceDeclSubBndrs (IfaceData {ifCons = IfDataTyCon _ cons})
  = nub (concatMap fld_occs cons) 	-- Eliminate duplicate fields
    ++ concatMap dc_occs cons
  where
    fld_occs (IfVanillaCon { ifConFields = fields }) = fields
    fld_occs (IfGadtCon {}) 			     = []
    dc_occs con_decl
	| has_wrapper = [con_occ, work_occ, wrap_occ]
	| otherwise   = [con_occ, work_occ]
	where
	  con_occ = ifConOcc con_decl
	  strs    = ifConStricts con_decl
	  wrap_occ = mkDataConWrapperOcc con_occ
	  work_occ = mkDataConWorkerOcc con_occ
	  has_wrapper = any isMarkedStrict strs	-- See MkId.mkDataConIds (sigh)
		-- ToDo: may miss strictness in existential dicts

ifaceDeclSubBndrs _other 		      = []

-----------------------------------------------------
--	Loading instance decls
-----------------------------------------------------

loadInsts :: Module -> [IfaceInst] -> IfL [(Name, Gated IfaceInst)]
loadInsts mod decls = mapM (loadInstDecl mod) decls

loadInstDecl mod decl@(IfaceInst {ifInstHead = inst_ty})
  = do 	{
	-- Find out what type constructors and classes are "gates" for the
	-- instance declaration.  If all these "gates" are slurped in then
	-- we should slurp the instance decl too.
	-- 
	-- We *don't* want to count names in the context part as gates, though.
	-- For example:
	--		instance Foo a => Baz (T a) where ...
	--
	-- Here the gates are Baz and T, but *not* Foo.
	-- 
	-- HOWEVER: functional dependencies make things more complicated
	--	class C a b | a->b where ...
	--	instance C Foo Baz where ...
	-- Here, the gates are really only C and Foo, *not* Baz.
	-- That is, if C and Foo are visible, even if Baz isn't, we must
	-- slurp the decl.
	--
	-- Rather than take fundeps into account "properly", we just slurp
	-- if C is visible and *any one* of the Names in the types
	-- This is a slightly brutal approximation, but most instance decls
	-- are regular H98 ones and it's perfect for them.
	--
	-- NOTICE that we rename the type before extracting its free
	-- variables.  The free-variable finder for a renamed HsType 
	-- does the Right Thing for built-in syntax like [] and (,).
	  let { (cls_ext, tc_exts) = ifaceInstGates inst_ty }
	; cls <- lookupIfaceExt cls_ext
	; tcs <- mapM lookupIfaceTc tc_exts
	; returnM (cls, (tcs, (mod,decl)))
	}

-----------------------------------------------------
--	Loading Rules
-----------------------------------------------------

loadRules :: Bool	-- Don't load pragmas into the decl pool
	  -> Module
	  -> [IfaceRule] -> IfL [Gated IfaceRule]
loadRules ignore_prags mod rules
  | ignore_prags = returnM []
  | otherwise    = mapM (loadRule mod) rules

loadRule :: Module -> IfaceRule -> IfL (Gated IfaceRule)
-- "Gate" the rule simply by a crude notion of the free vars of
-- the LHS.  It can be crude, because having too few free vars is safe.
loadRule mod decl@(IfaceRule {ifRuleHead = fn, ifRuleArgs = args})
  = do	{ names <- mapM lookupIfaceExt (fn : arg_fvs)
	; returnM (names, (mod, decl)) }
  where
    arg_fvs = [n | arg <- args, n <- crudeIfExprGblFvs arg]


---------------------------
crudeIfExprGblFvs :: IfaceExpr -> [IfaceExtName]
-- A crude approximation to the free external names of an IfExpr
-- Returns a subset of the true answer
crudeIfExprGblFvs (IfaceType ty) = get_tcs ty
crudeIfExprGblFvs (IfaceExt v)   = [v]
crudeIfExprGblFvs other	         = []	-- Well, I said it was crude

get_tcs :: IfaceType -> [IfaceExtName]
-- Get a crude subset of the TyCons of an IfaceType
get_tcs (IfaceTyVar _) 	    = []
get_tcs (IfaceAppTy t1 t2)  = get_tcs t1 ++ get_tcs t2
get_tcs (IfaceFunTy t1 t2)  = get_tcs t1 ++ get_tcs t2
get_tcs (IfaceForAllTy _ t) = get_tcs t
get_tcs (IfacePredTy st)    = case st of
				 IfaceClassP cl ts -> get_tcs_s ts
				 IfaceIParam _ t   -> get_tcs t
get_tcs (IfaceTyConApp (IfaceTc tc) ts) = tc : get_tcs_s ts
get_tcs (IfaceTyConApp other        ts) = get_tcs_s ts

-- The lists are always small => appending is fine
get_tcs_s :: [IfaceType] -> [IfaceExtName]
get_tcs_s tys = foldr ((++) . get_tcs) [] tys
\end{code}


%*********************************************************
%*							*
		Gating
%*							*
%*********************************************************

Extract the gates of an instance declaration

\begin{code}
ifaceInstGates :: IfaceType -> (IfaceExtName, [IfaceTyCon])
-- Return the class, and the tycons mentioned in the rest of the head
-- We only pick the TyCon at the root of each type, to avoid
-- difficulties with overlap.  For example, suppose there are interfaces
-- in the pool for
--	C Int b
--	C a [b]
--	C a [T] 
-- Then, if we are trying to resolve (C Int x), we need the first
--       if we are trying to resolve (C x [y]), we need *both* the latter
--	 two, even though T is not involved yet, so that we spot the overlap

ifaceInstGates (IfaceForAllTy _ t) 		   = ifaceInstGates t
ifaceInstGates (IfaceFunTy _ t)    		   = ifaceInstGates t
ifaceInstGates (IfacePredTy (IfaceClassP cls tys)) = instHeadGates cls tys
ifaceInstGates other = pprPanic "ifaceInstGates" (ppr other)
	-- The other cases should not happen

instHeadGates cls tys = (cls, mapCatMaybes root_tycon tys)
  where
    root_tycon (IfaceFunTy _ _)      = Just (IfaceTc funTyConExtName)
    root_tycon (IfaceTyConApp tc _)  = Just tc
    root_tycon other		     = Nothing

funTyConExtName = mkIfaceExtName (tyConName funTyCon)


predInstGates :: Class -> [Type] -> (Name, [Name])
-- The same function, only this time on the predicate found in a dictionary
predInstGates cls tys
  = (className cls, mapCatMaybes root_tycon tys)
  where
    root_tycon ty = case tcSplitTyConApp_maybe ty of
			Just (tc, _) -> Just (tyConName tc)
			Nothing	     -> Nothing
\end{code}


%*********************************************************
%*							*
\subsection{Reading an interface file}
%*							*
%*********************************************************

\begin{code}
findAndReadIface :: Bool 		-- True <=> explicit user import
		 -> SDoc -> Module 
		 -> IsBootInterface	-- True  <=> Look for a .hi-boot file
					-- False <=> Look for .hi file
		 -> IfM lcl (Either Message ModIface)
	-- Nothing <=> file not found, or unreadable, or illegible
	-- Just x  <=> successfully found and parsed 

	-- It *doesn't* add an error to the monad, because 
	-- sometimes it's ok to fail... see notes with loadInterface

findAndReadIface explicit doc_str mod_name hi_boot_file
  = do	{ traceIf (sep [hsep [ptext SLIT("Reading"), 
			      if hi_boot_file 
				then ptext SLIT("[boot]") 
				else empty,
			      ptext SLIT("interface for"), 
			      ppr mod_name <> semi],
		        nest 4 (ptext SLIT("reason:") <+> doc_str)])

	-- Check for GHC.Prim, and return its static interface
	; dflags <- getDOpts
	; let base_id = basePackageId (pkgState dflags)
	      base_pkg 
		| Just id <- base_id = ExternalPackage id
		| otherwise          = ThisPackage
		-- if basePackageId is Nothing, it means we must be
		-- compiling the base package.
	; if mod_name == gHC_PRIM
	  then returnM (Right (ghcPrimIface{ mi_package = base_pkg }))
	  else do

	-- Look for the file
	; mb_found <- ioToIOEnv (findHiFile dflags explicit mod_name hi_boot_file)
	; case mb_found of {
	      Left err -> do
		{ traceIf (ptext SLIT("...not found"))
		; dflags <- getDOpts
		; returnM (Left (noIfaceErr dflags mod_name err)) } ;

	      Right (file_path,pkg) -> do 

	-- Found file, so read it
	{ traceIf (ptext SLIT("readIFace") <+> text file_path)
	; read_result <- readIface mod_name file_path hi_boot_file
	; case read_result of
	    Left err    -> returnM (Left (badIfaceFile file_path err))
	    Right iface 
		| mi_module iface /= mod_name ->
		  return (Left (wrongIfaceModErr iface mod_name file_path))
		| otherwise ->
		  returnM (Right iface{mi_package=pkg})
			-- don't forget to fill in the package name...
	}}}

findHiFile :: DynFlags -> Bool -> Module -> IsBootInterface
	   -> IO (Either FindResult (FilePath, IfacePackage))
findHiFile dflags explicit mod_name hi_boot_file
 = do { 
	-- In interactive or --make mode, we are *not allowed* to demand-load
	-- a home package .hi file.  So don't even look for them.
	-- This helps in the case where you are sitting in eg. ghc/lib/std
	-- and start up GHCi - it won't complain that all the modules it tries
	-- to load are found in the home location.
	ghci_mode <- readIORef v_GhcMode ;
	let { home_allowed = hi_boot_file || 
			     not (isCompManagerMode ghci_mode) } ;
	maybe_found <-	if home_allowed 
			then findModule dflags mod_name explicit
			else findPackageModule dflags mod_name explicit;

	case maybe_found of {
	  Found loc pkg -> foundOk loc hi_boot_file pkg;
	  err           -> return (Left err) ;
	}}
   where
    foundOk loc hi_boot_file pkg = do {	-- Don't need module returned by finder

	-- Return the path to M.hi, M.hi-boot, or M.hi-boot-n as appropriate
	let { hi_path            = ml_hi_file loc ;
    	      hi_boot_path       = replaceFilenameSuffix hi_path hiBootExt ;
    	      hi_boot_ver_path   = replaceFilenameSuffix hi_path hiBootVerExt 
	    };

	if not hi_boot_file then
	   return (Right (hi_path,pkg))
	else do {
		hi_ver_exists <- doesFileExist hi_boot_ver_path ;
		if hi_ver_exists then return (Right (hi_boot_ver_path,pkg))
				 else return (Right (hi_boot_path,pkg))
	}}
\end{code}

@readIface@ tries just the one file.

\begin{code}
readIface :: Module -> String -> IsBootInterface 
	  -> IfM lcl (Either Message ModIface)
	-- Left err    <=> file not found, or unreadable, or illegible
	-- Right iface <=> successfully found and parsed 

readIface wanted_mod_name file_path is_hi_boot_file
  = do	{ dflags <- getDOpts
	; ioToIOEnv (read_iface dflags wanted_mod_name file_path is_hi_boot_file) }

read_iface dflags wanted_mod file_path is_hi_boot_file
 | is_hi_boot_file		-- Read ascii
 = do { res <- tryMost (hGetStringBuffer file_path) ;
	case res of {
	  Left exn     -> return (Left (text (showException exn))) ;
	  Right buffer -> 
        case unP parseIface (mkPState buffer loc dflags) of
	  PFailed span err -> return (Left (mkLocMessage span err))
	  POk _ iface 
	     | wanted_mod == actual_mod -> return (Right iface)
	     | otherwise		-> return (Left err) 
	     where
		actual_mod = mi_module iface
		err = hiModuleNameMismatchWarn wanted_mod actual_mod
     }}

 | otherwise		-- Read binary
 = do	{ res <- tryMost (readBinIface file_path)
	; case res of
	    Right iface -> return (Right iface)
	    Left exn    -> return (Left (text (showException exn))) }
 where
    loc  = mkSrcLoc (mkFastString file_path) 1 0
\end{code}


%*********************************************************
%*						 	 *
	Wired-in interface for GHC.Prim
%*							 *
%*********************************************************

\begin{code}
initExternalPackageState :: ExternalPackageState
initExternalPackageState
  = EPS { 
      eps_is_boot    = emptyModuleEnv,
      eps_PIT        = emptyPackageIfaceTable,
      eps_PTE        = emptyTypeEnv,
      eps_inst_env   = emptyInstEnv,
      eps_rule_base  = emptyRuleBase,
      eps_insts      = emptyNameEnv,
      eps_rules      = addRulesToPool [] (map mk_gated_rule builtinRules),
	-- Initialise the EPS rule pool with the built-in rules
      eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
			   , n_insts_in = 0, n_insts_out = 0
			   , n_rules_in = length builtinRules, n_rules_out = 0 }
    }
  where
    mk_gated_rule (fn_name, core_rule)
	= ([fn_name], (nameModule fn_name, IfaceBuiltinRule (mkIfaceExtName fn_name) core_rule))
\end{code}


%*********************************************************
%*						 	 *
	Wired-in interface for GHC.Prim
%*							 *
%*********************************************************

\begin{code}
ghcPrimIface :: ModIface
ghcPrimIface
  = (emptyModIface ThisPackage gHC_PRIM) {
	mi_exports  = [(gHC_PRIM, ghcPrimExports)],
	mi_decls    = [],
	mi_fixities = fixities,
	mi_fix_fn  = mkIfaceFixCache fixities
    }		
  where
    fixities = [(getOccName seqId, Fixity 0 InfixR)]
			-- seq is infixr 0
\end{code}

%*********************************************************
%*							*
\subsection{Statistics}
%*							*
%*********************************************************

\begin{code}
ifaceStats :: ExternalPackageState -> SDoc
ifaceStats eps 
  = hcat [text "Renamer stats: ", msg]
  where
    stats = eps_stats eps
    msg = vcat 
    	[int (n_ifaces_in stats) <+> text "interfaces read",
    	 hsep [ int (n_decls_out stats), text "type/class/variable imported, out of", 
    	        int (n_decls_in stats), text "read"],
    	 hsep [ int (n_insts_out stats), text "instance decls imported, out of",  
    	        int (n_insts_in stats), text "read"],
    	 hsep [ int (n_rules_out stats), text "rule decls imported, out of",  
    	        int (n_rules_in stats), text "read"]
	]
\end{code}    


%*********************************************************
%*						 	 *
\subsection{Errors}
%*							 *
%*********************************************************

\begin{code}
badIfaceFile file err
  = vcat [ptext SLIT("Bad interface file:") <+> text file, 
	  nest 4 err]

hiModuleNameMismatchWarn :: Module -> Module -> Message
hiModuleNameMismatchWarn requested_mod read_mod = 
    hsep [ ptext SLIT("Something is amiss; requested module name")
	 , ppr requested_mod
	 , ptext SLIT("differs from name found in the interface file")
   	 , ppr read_mod
  	 ]

noIfaceErr dflags mod_name (PackageHidden pkg)
  = ptext SLIT("Could not import") <+> quotes (ppr mod_name) <> colon
    $$ ptext SLIT("it is a member of package") <+> quotes (ppr pkg) <> comma
	 <+> ptext SLIT("which is hidden")

noIfaceErr dflags mod_name (ModuleHidden pkg)
  = ptext SLIT("Could not import") <+> quotes (ppr mod_name) <> colon
    $$ ptext SLIT("it is hidden") 
	<+> parens (ptext SLIT("in package") <+> quotes (ppr pkg))

noIfaceErr dflags mod_name (NotFound files)
  = ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name)
    $$ extra files
  where 
  extra files
    | verbosity dflags < 3 = 
        text "(use -v to see a list of the files searched for)"
    | otherwise =
        hang (ptext SLIT("locations searched:")) 4 (vcat (map text files))

wrongIfaceModErr iface mod_name file_path 
  = sep [ptext SLIT("Interface file") <+> iface_file,
         ptext SLIT("contains module") <+> quotes (ppr (mi_module iface)) <> comma,
         ptext SLIT("but we were expecting module") <+> quotes (ppr mod_name),
	 sep [ptext SLIT("Probable cause: the source code which generated"),
	     nest 2 iface_file,
	     ptext SLIT("has an incompatible module name")
	    ]
	]
  where iface_file = doubleQuotes (text file_path)
\end{code}