Commit 508a505e authored by simonpj's avatar simonpj

[project @ 2005-01-27 10:44:00 by simonpj]

--------------------------------------------
          Replace hi-boot files with hs-boot files
  	--------------------------------------------

This major commit completely re-organises the way that recursive modules
are dealt with.

  * It should have NO EFFECT if you do not use recursive modules

  * It is a BREAKING CHANGE if you do

====== Warning: .hi-file format has changed, so if you are
======		updating into an existing HEAD build, you'll
======		need to make clean and re-make


The details:  [documentation still to be done]

* Recursive loops are now broken with Foo.hs-boot (or Foo.lhs-boot),
  not Foo.hi-boot

* An hs-boot files is a proper source file.  It is compiled just like
  a regular Haskell source file:
	ghc Foo.hs		generates Foo.hi, Foo.o
	ghc Foo.hs-boot		generates Foo.hi-boot, Foo.o-boot

* hs-boot files are precisely a subset of Haskell. In particular:
	- they have the same import, export, and scoping rules
	- errors (such as kind errors) in hs-boot files are checked
  You do *not* need to mention the "original" name of something in
  an hs-boot file, any more than you do in any other Haskell module.

* The Foo.hi-boot file generated by compiling Foo.hs-boot is a machine-
  generated interface file, in precisely the same format as Foo.hi

* When compiling Foo.hs, its exports are checked for compatibility with
  Foo.hi-boot (previously generated by compiling Foo.hs-boot)

* The dependency analyser (ghc -M) knows about Foo.hs-boot files, and
  generates appropriate dependencies.  For regular source files it
  generates
	Foo.o : Foo.hs
	Foo.o : Baz.hi		-- Foo.hs imports Baz
	Foo.o : Bog.hi-boot	-- Foo.hs source-imports Bog

  For a hs-boot file it generates similar dependencies
	Bog.o-boot : Bog.hs-boot
	Bog.o-boot : Nib.hi	-- Bog.hs-boto imports Nib

* ghc -M is also enhanced to use the compilation manager dependency
  chasing, so that
	ghc -M Main
  will usually do the job.  No need to enumerate all the source files.

* The -c flag is no longer a "compiler mode". It simply means "omit the
  link step", and synonymous with -no-link.
parent f9d8c8e0
......@@ -86,6 +86,10 @@ WAYS=$(GhcCompilerWays)
# - create a link tree. The problem with requiring link trees is that
# Windows doesn't support symbolic links.
ifeq "$(stage)" ""
stage=1
endif
boot ::
$(MKDIRHIER) stage$(stage)
for i in $(ALL_DIRS); do \
......@@ -100,6 +104,8 @@ boot ::
# PS: 'ln -s foo baz' takes 'foo' relative to the path to 'baz'
# whereas 'cp foo baz' treats the two paths independently.
# Hence the "../.." in the ln command line
ifeq "$(stage)" "1"
ifeq "$(ghc_ge_603)" "NO"
ifeq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
for i in */*hi-boot*; do \
cp -u -f $$i stage$(stage)/$$i; \
......@@ -109,9 +115,7 @@ else
$(LN_S) -f ../../$$i stage$(stage)/$$i || true ; \
done
endif
ifeq "$(stage)" ""
stage=1
endif
endif
ifeq "$(stage)" "1"
......
\begin{code}
module DataCon where
import Name( Name )
data DataCon
dataConName :: DataCon -> Name
isVanillaDataCon :: DataCon -> Bool
\end{code}
\begin{code}
module IdInfo where
data IdInfo
data GlobalIdDetails
notGlobalId :: GlobalIdDetails
seqIdInfo :: IdInfo -> ()
\end{code}
\ No newline at end of file
\begin{code}
module MkId where
import Name( Name )
import DataCon( DataCon, DataConIds )
mkDataConIds :: Name -> Name -> DataCon -> DataConIds
\end{code}
......@@ -15,7 +15,7 @@ module Module
, pprModule -- :: ModuleName -> SDoc
, ModLocation(..),
, showModMsg
, addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn,
, moduleString -- :: ModuleName -> EncodedString
, moduleUserString -- :: ModuleName -> UserString
......@@ -30,7 +30,7 @@ module Module
, delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv
, lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv
, moduleEnvElts, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv
, extendModuleEnv_C
, extendModuleEnv_C, filterModuleEnv,
, ModuleSet, emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
......@@ -40,11 +40,9 @@ module Module
import OccName
import Outputable
import Unique ( Uniquable(..) )
import Maybes ( expectJust )
import UniqFM
import UniqSet
import Binary
import StringBuffer ( StringBuffer )
import FastString
\end{code}
......@@ -58,15 +56,9 @@ import FastString
data ModLocation
= ModLocation {
ml_hs_file :: Maybe FilePath,
-- the source file, if we have one. Package modules
-- The source file, if we have one. Package modules
-- probably don't have source files.
ml_hspp_file :: Maybe FilePath,
-- filename of preprocessed source, if we have
-- preprocessed it.
ml_hspp_buf :: Maybe StringBuffer,
-- the actual preprocessed source, maybe.
ml_hi_file :: FilePath,
-- Where the .hi file is, whether or not it exists
-- yet. Always of form foo.hi, even if there is an
......@@ -81,18 +73,6 @@ data ModLocation
instance Outputable ModLocation where
ppr = text . show
-- Rather a gruesome function to have in Module
showModMsg :: Bool -> Module -> ModLocation -> String
showModMsg use_object mod location =
mod_str ++ replicate (max 0 (16 - length mod_str)) ' '
++" ( " ++ expectJust "showModMsg" (ml_hs_file location) ++ ", "
++ (if use_object
then ml_obj_file location
else "interpreted")
++ " )"
where mod_str = moduleUserString mod
\end{code}
For a module in another package, the hs_file and obj_file
......@@ -103,6 +83,23 @@ correspond to actual files yet: for example, even if the object
file doesn't exist, the ModLocation still contains the path to
where the object file will reside if/when it is created.
\begin{code}
addBootSuffix :: FilePath -> FilePath
-- Add the "-boot" suffix to .hs, .hi and .o files
addBootSuffix path = path ++ "-boot"
addBootSuffix_maybe :: Bool -> FilePath -> FilePath
addBootSuffix_maybe is_boot path
| is_boot = addBootSuffix path
| otherwise = path
addBootSuffixLocn :: ModLocation -> ModLocation
addBootSuffixLocn locn
= locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn)
, ml_hi_file = addBootSuffix (ml_hi_file locn)
, ml_obj_file = addBootSuffix (ml_obj_file locn) }
\end{code}
%************************************************************************
%* *
......@@ -188,7 +185,9 @@ lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
elemModuleEnv :: Module -> ModuleEnv a -> Bool
foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
filterModuleEnv :: (a -> Bool) -> ModuleEnv a -> ModuleEnv a
filterModuleEnv = filterUFM
elemModuleEnv = elemUFM
extendModuleEnv = addToUFM
extendModuleEnv_C = addToUFM_C
......
\begin{code}
module Module where
data Module
\end{code}
\begin{code}
module Name where
data Name
\end{code}
\begin{code}
module OccName where
data OccName
\end{code}
\begin{code}
module CgBindery where
import VarEnv( IdEnv )
data CgIdInfo
data VolatileLoc
data StableLoc
type CgBindings = IdEnv CgIdInfo
nukeVolatileBinds :: CgBindings -> CgBindings
\end{code}
\ No newline at end of file
\begin{code}
module CgExpr where
import StgSyn( StgExpr )
import CgMonad( Code )
cgExpr :: StgExpr -> Code
\end{code}
\begin{code}
module ClosureInfo where
data LambdaFormInfo
data ClosureInfo
\end{code}
\ No newline at end of file
This diff is collapsed.
......@@ -9,6 +9,7 @@ module Desugar ( deSugar, deSugarExpr ) where
#include "HsVersions.h"
import CmdLineOpts ( DynFlag(..), DynFlags(..), dopt, opt_SccProfilingOn )
import DriverPhases ( isHsBoot )
import HscTypes ( ModGuts(..), ModGuts, HscEnv(..), GhciMode(..),
Dependencies(..), TypeEnv, IsBootInterface )
import HsSyn ( RuleDecl(..), RuleBndr(..), HsExpr(..), LHsExpr,
......@@ -59,6 +60,7 @@ deSugar :: HscEnv -> TcGblEnv -> IO (Bag WarnMsg, Maybe ModGuts)
deSugar hsc_env
tcg_env@(TcGblEnv { tcg_mod = mod,
tcg_src = hsc_src,
tcg_type_env = type_env,
tcg_imports = imports,
tcg_exports = exports,
......@@ -146,6 +148,7 @@ deSugar hsc_env
mod_guts = ModGuts {
mg_module = mod,
mg_boot = isHsBoot hsc_src,
mg_exports = exports,
mg_deps = deps,
mg_usages = usages,
......
\begin{code}
module DsExpr where
import HsSyn ( HsExpr, LHsExpr, HsBindGroup )
import Var ( Id )
import DsMonad ( DsM )
import CoreSyn ( CoreExpr )
dsExpr :: HsExpr Id -> DsM CoreExpr
dsLExpr :: LHsExpr Id -> DsM CoreExpr
dsLet :: [HsBindGroup Id] -> CoreExpr -> DsM CoreExpr
\end{code}
......@@ -20,14 +20,19 @@ module DsMonad (
DsMetaEnv, DsMetaVal(..), dsLookupMetaEnv, dsExtendMetaEnv,
dsWarn,
DsWarning,
DsMatchContext(..)
-- Warnings
DsWarning, dsWarn,
-- Data types
DsMatchContext(..),
EquationInfo(..), MatchResult(..),
CanItFail(..), orFail
) where
#include "HsVersions.h"
import TcRnMonad
import CoreSyn ( CoreExpr )
import HsSyn ( HsExpr, HsMatchContext, Pat )
import TcIface ( tcIfaceGlobal )
import RdrName ( GlobalRdrEnv )
......@@ -56,6 +61,49 @@ import DATA_IOREF ( newIORef, readIORef )
infixr 9 `thenDs`
\end{code}
%************************************************************************
%* *
Data types for the desugarer
%* *
%************************************************************************
\begin{code}
data DsMatchContext
= DsMatchContext (HsMatchContext Name) [Pat Id] SrcSpan
| NoMatchContext
deriving ()
data EquationInfo
= EqnInfo { eqn_pats :: [Pat Id], -- The patterns for an eqn
eqn_rhs :: MatchResult } -- What to do after match
-- The semantics of (match vs (EqnInfo wrap pats rhs)) is the MatchResult
-- \fail. wrap (case vs of { pats -> rhs fail })
-- where vs are not in the domain of wrap
-- A MatchResult is an expression with a hole in it
data MatchResult
= MatchResult
CanItFail -- Tells whether the failure expression is used
(CoreExpr -> DsM CoreExpr)
-- Takes a expression to plug in at the
-- failure point(s). The expression should
-- be duplicatable!
data CanItFail = CanFail | CantFail
orFail CantFail CantFail = CantFail
orFail _ _ = CanFail
\end{code}
%************************************************************************
%* *
Monad stuff
%* *
%************************************************************************
Now the mondo monad magic (yes, @DsM@ is a silly name)---carry around
a @UniqueSupply@ and some annotations, which
presumably include source-file location information:
......@@ -129,6 +177,12 @@ initDs hsc_env mod rdr_env type_env thing_inside
mk_warn (loc,sdoc) = mkWarnMsg loc print_unqual sdoc
\end{code}
%************************************************************************
%* *
Operations in the monad
%* *
%************************************************************************
And all this mysterious stuff is so we can occasionally reach out and
grab one or more names. @newLocalDs@ isn't exported---exported
functions are defined with it. The difference in name-strings makes
......@@ -222,15 +276,3 @@ dsExtendMetaEnv menv thing_inside
\end{code}
%************************************************************************
%* *
\subsection{Type synonym @EquationInfo@ and access functions for its pieces}
%* *
%************************************************************************
\begin{code}
data DsMatchContext
= DsMatchContext (HsMatchContext Name) [Pat Id] SrcSpan
| NoMatchContext
deriving ()
\end{code}
......@@ -187,14 +187,6 @@ The ``equation info'' used by @match@ is relatively complicated and
worthy of a type synonym and a few handy functions.
\begin{code}
data EquationInfo
= EqnInfo { eqn_pats :: [Pat Id], -- The patterns for an eqn
eqn_rhs :: MatchResult } -- What to do after match
-- The semantics of (match vs (EqnInfo wrap pats rhs)) is the MatchResult
-- \fail. wrap (case vs of { pats -> rhs fail })
-- where vs are not in the domain of wrap
firstPat :: EquationInfo -> Pat Id
firstPat eqn = head (eqn_pats eqn)
......@@ -208,23 +200,6 @@ shiftPats (ConPatOut _ _ _ _ (PrefixCon arg_pats) _ : pats) = map unLoc arg_pats
shiftPats (pat_with_no_sub_pats : pats) = pats
\end{code}
\begin{code}
-- A MatchResult is an expression with a hole in it
data MatchResult
= MatchResult
CanItFail -- Tells whether the failure expression is used
(CoreExpr -> DsM CoreExpr)
-- Takes a expression to plug in at the
-- failure point(s). The expression should
-- be duplicatable!
data CanItFail = CanFail | CantFail
orFail CantFail CantFail = CantFail
orFail _ _ = CanFail
\end{code}
Functions on MatchResults
\begin{code}
......
......@@ -2,8 +2,8 @@ module Match where
match :: [Var.Id]
-> TcType.TcType
-> [DsUtils.EquationInfo]
-> DsMonad.DsM DsUtils.MatchResult
-> [DsMonad.EquationInfo]
-> DsMonad.DsM DsMonad.MatchResult
matchWrapper
:: HsExpr.HsMatchContext Name.Name
......@@ -23,5 +23,5 @@ matchSinglePat
-> DsMonad.DsMatchContext
-> HsPat.LPat Var.Id
-> TcType.TcType
-> DsUtils.MatchResult
-> DsMonad.DsM DsUtils.MatchResult
-> DsMonad.MatchResult
-> DsMonad.DsM DsMonad.MatchResult
\begin{code}
module Match where
import Var ( Id )
import TcType ( TcType )
import DsMonad ( DsM, DsMatchContext, EquationInfo, MatchResult )
import CoreSyn ( CoreExpr )
import HsSyn ( LPat, HsMatchContext, MatchGroup )
import Name ( Name )
match :: [Id]
-> TcType
-> [EquationInfo]
-> DsM MatchResult
matchWrapper
:: HsMatchContext Name
-> MatchGroup Id
-> DsM ([Id], CoreExpr)
matchSimply
:: CoreExpr
-> HsMatchContext Name
-> LPat Id
-> CoreExpr
-> CoreExpr
-> DsM CoreExpr
matchSinglePat
:: CoreExpr
-> DsMatchContext
-> LPat Id
-> TcType
-> MatchResult
-> DsM MatchResult
\end{code}
......@@ -124,7 +124,6 @@ emptyPLS dflags = PersistentLinkerState {
where init_pkgs
| ExtPackage rts_id <- rtsPackageId (pkgState dflags) = [rts_id]
| otherwise = []
\end{code}
\begin{code}
......
......@@ -242,16 +242,20 @@ sigName (L _ sig) = f sig
f (FixSig (FixitySig n _)) = Just (unLoc n)
f other = Nothing
isFixitySig :: Sig name -> Bool
isFixitySig (FixSig _) = True
isFixitySig _ = False
isFixityLSig :: LSig name -> Bool
isFixityLSig (L _ (FixSig _)) = True
isFixityLSig _ = False
isPragSig :: Sig name -> Bool
isVanillaLSig :: LSig name -> Bool
isVanillaLSig (L _(Sig name _)) = True
isVanillaLSig sig = False
isPragLSig :: LSig name -> Bool
-- Identifies pragmas
isPragSig (SpecSig _ _) = True
isPragSig (InlineSig _ _ _) = True
isPragSig (SpecInstSig _) = True
isPragSig other = False
isPragLSig (L _ (SpecSig _ _)) = True
isPragLSig (L _ (InlineSig _ _ _)) = True
isPragLSig (L _ (SpecInstSig _)) = True
isPragLSig other = False
hsSigDoc (Sig _ _) = ptext SLIT("type signature")
hsSigDoc (SpecSig _ _) = ptext SLIT("SPECIALISE pragma")
......
\begin{code}
module HsExpr where
import SrcLoc ( Located )
import Outputable ( SDoc, OutputableBndr )
import {-# SOURCE #-} HsPat ( LPat )
data HsExpr i
data HsSplice i
data MatchGroup a
data GRHSs a
type LHsExpr a = Located (HsExpr a)
pprExpr :: (OutputableBndr i) =>
HsExpr i -> SDoc
pprSplice :: (OutputableBndr i) =>
HsSplice i -> SDoc
pprPatBind :: (OutputableBndr b, OutputableBndr i) =>
LPat b -> GRHSs i -> SDoc
pprFunBind :: (OutputableBndr i) =>
i -> MatchGroup i -> SDoc
\end{code}
\begin{code}
module HsPat where
import SrcLoc( Located )
data Pat i
type LPat i = Located (Pat i)
\end{code}
......@@ -94,6 +94,7 @@ readBinIface hi_path = getBinFileWithDict hi_path
instance Binary ModIface where
put_ bh (ModIface {
mi_module = mod,
mi_boot = is_boot,
mi_mod_vers = mod_vers,
mi_package = _, -- we ignore the package on output
mi_orphan = orphan,
......@@ -111,6 +112,7 @@ instance Binary ModIface where
build_tag <- readIORef v_Build_tag
put bh build_tag
put_ bh mod
put_ bh is_boot
put_ bh mod_vers
put_ bh orphan
lazyPut bh deps
......@@ -145,7 +147,7 @@ instance Binary ModIface where
++ build_tag ++ ", found " ++ check_way))
mod_name <- get bh
is_boot <- get bh
mod_vers <- get bh
orphan <- get bh
deps <- lazyGet bh
......@@ -161,8 +163,8 @@ instance Binary ModIface where
return (ModIface {
mi_package = HomePackage, -- to be filled in properly later
mi_module = mod_name,
mi_boot = is_boot,
mi_mod_vers = mod_vers,
mi_boot = False, -- Binary interfaces are never .hi-boot files!
mi_orphan = orphan,
mi_deps = deps,
mi_usages = usages,
......
......@@ -9,7 +9,7 @@ module IfaceType (
IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..),
IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr,
IfaceExtName(..), mkIfaceExtName, ifaceTyConName,
IfaceExtName(..), mkIfaceExtName, ifaceTyConName, ifPrintUnqual,
-- Conversion from Type -> IfaceType
toIfaceType, toIfacePred, toIfaceContext,
......@@ -65,6 +65,11 @@ data IfaceExtName
mkIfaceExtName name = ExtPkg (nameModule name) (nameOccName name)
-- Local helper for wired-in names
ifPrintUnqual :: PrintUnqualified -> IfaceExtName -> Bool
ifPrintUnqual print_unqual (ExtPkg mod occ) = print_unqual mod occ
ifPrintUnqual print_unqual (HomePkg mod occ _) = print_unqual mod occ
ifPrintUnqual print_unqual other = True
\end{code}
......
......@@ -9,8 +9,7 @@ module LoadIface (
loadSrcInterface, loadOrphanModules, loadHiBootInterface,
readIface, -- Used when reading the module's old interface
predInstGates, ifaceInstGates, ifaceStats, discardDeclPrags,
initExternalPackageState,
noIfaceErr, -- used by CompManager too
initExternalPackageState
) where
#include "HsVersions.h"
......@@ -19,10 +18,7 @@ import {-# SOURCE #-} TcIface( tcIfaceDecl )
import Packages ( PackageState(..), PackageIdH(..), isHomePackage )
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(..),
......@@ -55,28 +51,24 @@ import Name ( Name {-instance NamedThing-}, getOccName,
import NameEnv
import MkId ( seqId )
import Module ( Module, ModLocation(ml_hi_file), emptyModuleEnv,
addBootSuffix_maybe,
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 SrcLoc ( importedSrcLoc )
import Maybes ( mapCatMaybes, MaybeErr(..) )
import StringBuffer ( hGetStringBuffer )
import FastString ( mkFastString )
import ErrUtils ( Message, mkLocMessage )
import Finder ( findModule, findPackageModule, FindResult(..),
hiBootFilePath )
import Lexer
import ErrUtils ( Message )
import Finder ( findModule, findPackageModule, FindResult(..), cantFindError )
import Outputable
import BinIface ( readBinIface )
import Panic ( ghcError, tryMost, showException, GhcException(..) )
import List ( nub )
import DATA_IOREF ( readIORef )
import Directory
\end{code}
......@@ -576,7 +568,7 @@ findAndReadIface explicit doc_str mod_name hi_boot_file
Failed err -> do
{ traceIf (ptext SLIT("...not found"))
; dflags <- getDOpts
; returnM (Failed (noIfaceErr dflags mod_name err)) } ;
; returnM (Failed (cantFindError dflags mod_name err)) } ;
Succeeded (file_path, pkg) -> do
......@@ -603,18 +595,17 @@ findHiFile dflags explicit mod_name hi_boot_file
-- 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) } ;
let { home_allowed = not (isCompManagerMode ghci_mode) } ;
maybe_found <- if home_allowed
then findModule dflags mod_name explicit
then findModule dflags mod_name explicit
else findPackageModule dflags mod_name explicit;
case maybe_found of
Found loc pkg
| hi_boot_file -> do { hi_boot_path <- hiBootFilePath loc
; return (Succeeded (hi_boot_path, pkg)) }
| otherwise -> return (Succeeded (ml_hi_file loc, pkg)) ;
err -> return (Failed err)
Found loc pkg -> return (Succeeded (path, pkg))
where
path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc)
err -> return (Failed err)
}
\end{code}
......@@ -626,33 +617,20 @@ readIface :: Module -> String -> IsBootInterface
-- Failed err <=> file not found, or unreadable, or illegible
-- Succeeded iface <=> successfully found and parsed
readIface wanted_mod_name file_path is_hi_boot_file
readIface wanted_mod 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 (Failed (text (showException exn))) ;
Right buffer ->
case unP parseIface (mkPState buffer loc dflags) of
PFailed span err -> return (Failed (mkLocMessage span err))
POk _ iface
| wanted_mod == actual_mod -> return (Succeeded iface)
| otherwise -> return (Failed err)
where
actual_mod = mi_module iface
err = hiModuleNameMismatchWarn wanted_mod actual_mod
}}
| otherwise -- Read binary
= do { res <- tryMost (readBinIface file_path)
; ioToIOEnv $ do
{ res <- tryMost (readBinIface file_path)
; case res of
Right iface -> return (Succeeded iface)
Left exn -> return (Failed (text (showException exn))) }
where
loc = mkSrcLoc (mkFastString file_path) 1 0
Right iface
| wanted_mod == actual_mod -> return (Succeeded iface)
| otherwise -> return (Failed err)
where
actual_mod = mi_module iface
err = hiModuleNameMismatchWarn wanted_mod actual_mod
Left exn -> return (Failed (text (showException exn)))
}}
\end{code}
......@@ -748,27 +726,6 @@ hiModuleNameMismatchWarn requested_mod read_mod =
, ppr read_mod
]
noIfaceErr :: DynFlags -> Module -> FindResult -> SDoc
noIfaceErr dflags mod_name (PackageHidden pkg)
= ptext SLIT("Could not import") <+> quotes (ppr mod_name) <> colon
$$ ptext SLIT("it is a member of package") <+> ppr pkg <> comma
<+> ptext SLIT("which is hidden")