Commit ac80e0de authored by simonpj's avatar simonpj

[project @ 2005-01-18 12:18:11 by simonpj]

------------------------
    Reorganisation of hi-boot files
  	------------------------

The main point of this commit is to arrange that in the Compilation
Manager's dependendency graph, hi-boot files are proper nodes. This
is important to make sure that we compile everything in the right
order.  It's a step towards hs-boot files.

* The fundamental change is that CompManager.ModSummary has a new
  field, ms_boot :: IsBootInterface

  I also tided up CompManager a bit.  No change to the Basic Plan.

  ModSummary is now exported abstractly from CompManager (was concrete)

* Hi-boot files now have import declarations.  The idea is they are
  compulsory, so that the dependency analyser can find them

* I changed an invariant: the Compilation Manager used to ensure that
  hscMain was given a HomePackageTable only for the modules 'below' the
  one being compiled.  This was really only important for instances and
  rules, and it was a bit inconvenient.  So I moved the filter to the
  compiler itself: see HscTypes.hptInstances and hptRules.

* Module Packages.hs now defines
    data PackageIdH
    = HomePackage 		-- The "home" package is the package
 				-- curently being compiled
    | ExtPackage PackageId	-- An "external" package is any other package

   It was just a Maybe type before, so this makes it a bit clearer.

* I tried to add a bit better location info to the IfM monad, so that
  errors in interfaces come with a slightly more helpful error message.
  See the if_loc field in TcRnTypes --- and follow-on consequences

* Changed Either to Maybes.MaybeErr in a couple of places (more perspicuous)
parent 43d5a248
module Module where
import GHC.Base
data Module
......@@ -50,6 +50,7 @@ module Unique (
#include "HsVersions.h"
import BasicTypes ( Boxity(..) )
import PackageConfig ( PackageId, packageIdFS )
import FastString ( FastString, uniqueOfFS )
import Outputable
import FastTypes
......@@ -158,6 +159,9 @@ x `hasKey` k = getUnique x == k
instance Uniquable FastString where
getUnique fs = mkUniqueGrimily (I# (uniqueOfFS fs))
instance Uniquable PackageId where
getUnique pid = getUnique (packageIdFS pid)
instance Uniquable Int where
getUnique i = mkUniqueGrimily i
\end{code}
......
This diff is collapsed.
......@@ -15,7 +15,7 @@ import HsSyn ( RuleDecl(..), RuleBndr(..), HsExpr(..), LHsExpr,
HsBindGroup(..), LRuleDecl, HsBind(..) )
import TcRnTypes ( TcGblEnv(..), ImportAvails(..) )
import MkIface ( mkUsageInfo )
import Id ( Id, setIdExported, idName, idIsFrom, isLocalId )
import Id ( Id, setIdExported, idName, idIsFrom )
import Name ( Name, isExternalName )
import CoreSyn
import PprCore ( pprIdRules, pprCoreExpr )
......@@ -35,7 +35,7 @@ import VarSet
import Bag ( Bag, isEmptyBag, emptyBag, bagToList )
import CoreLint ( showPass, endPass )
import CoreFVs ( ruleRhsFreeVars )
import Packages ( PackageState(thPackageId) )
import Packages ( PackageState(thPackageId), PackageIdH(..) )
import ErrUtils ( doIfSet, dumpIfSet_dyn, pprBagOfWarnings,
errorsFound, WarnMsg )
import ListSetOps ( insertList )
......@@ -114,7 +114,7 @@ deSugar hsc_env
; th_used <- readIORef th_var -- Whether TH is used
; let used_names = allUses dus `unionNameSets` dfun_uses
thPackage = thPackageId (pkgState dflags)
pkgs | Just th_id <- thPackage, th_used
pkgs | ExtPackage th_id <- thPackage, th_used
= insertList th_id (imp_dep_pkgs imports)
| otherwise
= imp_dep_pkgs imports
......
......@@ -79,7 +79,7 @@ type DsWarning = (SrcSpan, SDoc)
data DsGblEnv = DsGblEnv {
ds_mod :: Module, -- For SCC profiling
ds_warns :: IORef (Bag DsWarning), -- Warning messages
ds_if_env :: IfGblEnv -- Used for looking up global,
ds_if_env :: (IfGblEnv, IfLclEnv) -- Used for looking up global,
-- possibly-imported things
}
......@@ -109,9 +109,10 @@ initDs :: HscEnv
initDs hsc_env mod rdr_env type_env thing_inside
= do { warn_var <- newIORef emptyBag
; let { if_env = IfGblEnv { if_rec_types = Just (mod, return type_env) }
; let { if_genv = IfGblEnv { if_rec_types = Just (mod, return type_env) }
; if_lenv = mkIfLclEnv mod (ptext SLIT("GHC error in desugarer lookup in") <+> ppr mod)
; gbl_env = DsGblEnv { ds_mod = mod,
ds_if_env = if_env,
ds_if_env = (if_genv, if_lenv),
ds_warns = warn_var }
; lcl_env = DsLclEnv { ds_meta = emptyNameEnv,
ds_loc = noSrcSpan } }
......@@ -192,7 +193,7 @@ dsLookupGlobal :: Name -> DsM TyThing
-- Very like TcEnv.tcLookupGlobal
dsLookupGlobal name
= do { env <- getGblEnv
; setEnvs (ds_if_env env, ())
; setEnvs (ds_if_env env)
(tcIfaceGlobal name) }
dsLookupGlobalId :: Name -> DsM Id
......
{-# OPTIONS -#include "Linker.h" #-}
-----------------------------------------------------------------------------
-- $Id: InteractiveUI.hs,v 1.182 2005/01/12 12:44:25 ross Exp $
-- $Id: InteractiveUI.hs,v 1.183 2005/01/18 12:18:19 simonpj Exp $
--
-- GHC Interactive User Interface
--
......@@ -26,7 +26,6 @@ import DriverState
import DriverUtil ( remove_spaces )
import Linker ( showLinkerState, linkPackages )
import Util
import Module ( showModMsg, lookupModuleEnv )
import Name ( Name, NamedThing(..) )
import OccName ( OccName, isSymOcc, occNameUserString )
import BasicTypes ( StrictnessMark(..), defaultFixity, SuccessFlag(..) )
......@@ -972,22 +971,10 @@ showCmd str =
["linker"] -> io showLinkerState
_ -> throwDyn (CmdLineError "syntax: :show [modules|bindings]")
showModules = do
cms <- getCmState
let (mg, hpt) = cmGetModInfo cms
mapM_ (showModule hpt) mg
showModule :: HomePackageTable -> ModSummary -> GHCi ()
showModule hpt mod_summary
= case lookupModuleEnv hpt mod of
Nothing -> panic "missing linkable"
Just mod_info -> io (putStrLn (showModMsg obj_linkable mod locn))
where
obj_linkable = isObjectLinkable (hm_linkable mod_info)
where
mod = ms_mod mod_summary
locn = ms_location mod_summary
showModules
= do { cms <- getCmState
; let show_one ms = io (putStrLn (cmShowModule cms ms))
; mapM_ show_one (cmGetModuleGraph cms) }
showBindings = do
cms <- getCmState
......
......@@ -122,7 +122,7 @@ emptyPLS dflags = PersistentLinkerState {
-- The linker's symbol table is populated with RTS symbols using an
-- explicit list. See rts/Linker.c for details.
where init_pkgs
| Just rts_id <- rtsPackageId (pkgState dflags) = [rts_id]
| ExtPackage rts_id <- rtsPackageId (pkgState dflags) = [rts_id]
| otherwise = []
\end{code}
......@@ -386,7 +386,7 @@ getLinkDeps dflags hpt pit mods
-- Get the things needed for the specified module
-- This is rather similar to the code in RnNames.importsFromImportDecl
get_deps mod
| ExternalPackage p <- mi_package iface
| ExtPackage p <- mi_package iface
= ([], p : dep_pkgs deps)
| otherwise
= (mod : [m | (m,_) <- dep_mods deps], dep_pkgs deps)
......
......@@ -14,6 +14,7 @@ import BasicTypes
import NewDemand
import IfaceSyn
import VarEnv
import Packages ( PackageIdH(..) )
import Class ( DefMeth(..) )
import CostCentre
import DriverState ( v_Build_tag )
......@@ -158,7 +159,7 @@ instance Binary ModIface where
rules <- {-# SCC "bin_rules" #-} lazyGet bh
rule_vers <- get bh
return (ModIface {
mi_package = ThisPackage, -- to be filled in properly later
mi_package = HomePackage, -- to be filled in properly later
mi_module = mod_name,
mi_mod_vers = mod_vers,
mi_boot = False, -- Binary interfaces are never .hi-boot files!
......
......@@ -51,7 +51,8 @@ data IfaceExtName
-- of whether they are home-pkg or not
| HomePkg Module OccName Version -- From another module in home package;
-- has version #
-- has version #; in all other respects,
-- HomePkg and ExtPkg are the same
| LocalTop OccName -- Top-level from the same module as
-- the enclosing IfaceDecl
......
......@@ -17,7 +17,7 @@ module LoadIface (
import {-# SOURCE #-} TcIface( tcIfaceDecl )
import Packages ( PackageState(..), isHomeModule )
import Packages ( PackageState(..), PackageIdH(..), isHomePackage )
import DriverState ( v_GhcMode, isCompManagerMode )
import DriverUtil ( replaceFilenameSuffix )
import CmdLineOpts ( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ) )
......@@ -32,7 +32,7 @@ import IfaceEnv ( newGlobalBinder, lookupIfaceExt, lookupIfaceTc,
lookupOrig )
import HscTypes ( ModIface(..), TyThing, emptyModIface, EpsStats(..),
addEpsInStats, ExternalPackageState(..),
PackageTypeEnv, emptyTypeEnv, IfacePackage(..),
PackageTypeEnv, emptyTypeEnv,
lookupIfaceByModule, emptyPackageIfaceTable,
IsBootInterface, mkIfaceFixCache, Gated,
implicitTyThings, addRulesToPool, addInstsToPool,
......@@ -62,16 +62,16 @@ import OccName ( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc, mkClassDataC
import Class ( Class, className )
import TyCon ( tyConName )
import SrcLoc ( mkSrcLoc, importedSrcLoc )
import Maybes ( isJust, mapCatMaybes )
import Maybes ( mapCatMaybes, MaybeErr(..) )
import StringBuffer ( hGetStringBuffer )
import FastString ( mkFastString )
import ErrUtils ( Message, mkLocMessage )
import Finder ( findModule, findPackageModule, FindResult(..),
hiBootExt, hiBootVerExt )
hiBootFilePath )
import Lexer
import Outputable
import BinIface ( readBinIface )
import Panic
import Panic ( ghcError, tryMost, showException, GhcException(..) )
import List ( nub )
import DATA_IOREF ( readIORef )
......@@ -97,8 +97,8 @@ 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
Failed err -> failWithTc (elaborate err)
Succeeded iface -> return iface
}
where
elaborate err = hang (ptext SLIT("Failed to load interface for") <+>
......@@ -170,8 +170,8 @@ loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
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 }
Failed err -> ghcError (ProgramError (showSDoc err))
Succeeded iface -> return iface }
\end{code}
......@@ -187,7 +187,7 @@ loadSysInterface doc mod_name
\begin{code}
loadInterface :: SDoc -> Module -> WhereFrom
-> IfM lcl (Either Message ModIface)
-> IfM lcl (MaybeErr 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)
......@@ -195,19 +195,18 @@ loadInterface :: SDoc -> Module -> WhereFrom
--
-- 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
-- is no longer used
loadInterface doc_str mod_name from
loadInterface doc_str mod from
= do { -- Read the state
(eps,hpt) <- getEpsAndHpt
; traceIf (text "Considering whether to load" <+> ppr mod_name <+> ppr from)
; traceIf (text "Considering whether to load" <+> ppr mod <+> ppr from)
-- Check whether we have the interface already
; case lookupIfaceByModule hpt (eps_PIT eps) mod_name of {
; case lookupIfaceByModule hpt (eps_PIT eps) mod of {
Just iface
-> returnM (Right iface) ; -- Already loaded
-> returnM (Succeeded 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.
......@@ -217,7 +216,7 @@ loadInterface doc_str mod_name from
ImportByUser usr_boot -> usr_boot
ImportBySystem -> sys_boot
; mb_dep = lookupModuleEnv (eps_is_boot eps) mod_name
; mb_dep = lookupModuleEnv (eps_is_boot eps) mod
; sys_boot = case mb_dep of
Just (_, is_boot) -> is_boot
Nothing -> False
......@@ -227,32 +226,33 @@ loadInterface doc_str mod_name from
-- READ THE MODULE IN
; let explicit | ImportByUser _ <- from = True
| otherwise = False
; read_result <- findAndReadIface explicit doc_str mod_name hi_boot_file
; read_result <- findAndReadIface explicit doc_str mod hi_boot_file
; dflags <- getDOpts
; case read_result of {
Left err -> do
{ let fake_iface = emptyModIface ThisPackage mod_name
Failed err -> do
{ let fake_iface = emptyModIface HomePackage mod
; 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) } ;
; returnM (Failed err) } ;
-- Found and parsed!
Right iface ->
Succeeded (iface, file_path) -- Sanity check:
| ImportBySystem <- from, -- system-importing...
isHomePackage (mi_package iface), -- ...a home-package module
Nothing <- mb_dep -- ...that we know nothing about
-> returnM (Failed (badDepMsg mod))
let { mod = mi_module iface } in
| otherwise ->
-- 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) )
let
loc_doc = text file_path <+> colon
in
initIfaceLcl mod loc_doc $ do
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
......@@ -269,10 +269,12 @@ loadInterface doc_str mod_name from
-- 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)
; ignore_prags <- doptM Opt_IgnoreInterfacePragmas
; new_eps_decls <- mapM (loadDecl ignore_prags) (mi_decls iface)
; new_eps_insts <- mapM loadInst (mi_insts iface)
; new_eps_rules <- if ignore_prags
then return []
else mapM loadRule (mi_rules iface)
; let { final_iface = iface { mi_decls = panic "No mi_decls in PIT",
mi_insts = panic "No mi_insts in PIT",
......@@ -286,8 +288,13 @@ loadInterface doc_str mod_name from
eps_stats = addEpsInStats (eps_stats eps) (length new_eps_decls)
(length new_eps_insts) (length new_eps_rules) }
; return (Right final_iface)
}}}}}
; return (Succeeded final_iface)
}}}}
badDepMsg mod
= hang (ptext SLIT("Interface file inconsistency:"))
2 (sep [ptext SLIT("home-package module") <+> quotes (ppr mod) <+> ptext SLIT("is mentioned,"),
ptext SLIT("but does not appear in the dependencies of the interface")])
-----------------------------------------------------
-- Loading type/class/value decls
......@@ -301,18 +308,16 @@ loadInterface doc_str mod_name from
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
loadDecl :: Bool -- Don't load pragmas into the decl pool
-> (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)
loadDecl ignore_prags (_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)
mod <- getIfModule
; main_name <- mk_new_bndr mod Nothing (ifName decl)
; implicit_names <- mapM (mk_new_bndr mod (Just main_name)) (ifaceDeclSubBndrs decl)
-- Typecheck the thing, lazily
; thing <- forkM doc (bumpDeclStats main_name >> tcIfaceDecl stripped_decl)
......@@ -334,8 +339,10 @@ loadDecl ignore_prags mod (_version, decl)
-- * 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)
mk_new_bndr mod mb_parent occ
= newGlobalBinder mod occ mb_parent
(importedSrcLoc (moduleUserString mod))
doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)
discardDeclPrags :: IfaceDecl -> IfaceDecl
......@@ -399,10 +406,9 @@ ifaceDeclSubBndrs _other = []
-- Loading instance decls
-----------------------------------------------------
loadInsts :: Module -> [IfaceInst] -> IfL [(Name, Gated IfaceInst)]
loadInsts mod decls = mapM (loadInstDecl mod) decls
loadInst :: IfaceInst -> IfL (Name, Gated IfaceInst)
loadInstDecl mod decl@(IfaceInst {ifInstHead = inst_ty})
loadInst 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
......@@ -432,26 +438,21 @@ loadInstDecl mod decl@(IfaceInst {ifInstHead = inst_ty})
let { (cls_ext, tc_exts) = ifaceInstGates inst_ty }
; cls <- lookupIfaceExt cls_ext
; tcs <- mapM lookupIfaceTc tc_exts
; returnM (cls, (tcs, (mod,decl)))
; (mod, doc) <- getIfCtxt
; returnM (cls, (tcs, (mod, doc, 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)
loadRule :: 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})
loadRule decl@(IfaceRule {ifRuleHead = fn, ifRuleArgs = args})
= do { names <- mapM lookupIfaceExt (fn : arg_fvs)
; returnM (names, (mod, decl)) }
; (mod, doc) <- getIfCtxt
; returnM (names, (mod, doc, decl)) }
where
arg_fvs = [n | arg <- args, n <- crudeIfExprGblFvs arg]
......@@ -479,6 +480,11 @@ 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
----------------
getIfCtxt :: IfL (Module, SDoc)
getIfCtxt = do { env <- getLclEnv; return (if_mod env, if_loc env) }
\end{code}
......@@ -540,7 +546,7 @@ 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)
-> IfM lcl (MaybeErr Message (ModIface, FilePath))
-- Nothing <=> file not found, or unreadable, or illegible
-- Just x <=> successfully found and parsed
......@@ -558,41 +564,37 @@ findAndReadIface explicit doc_str mod_name hi_boot_file
-- 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.
; let base_pkg = basePackageId (pkgState dflags)
; if mod_name == gHC_PRIM
then returnM (Right (ghcPrimIface{ mi_package = base_pkg }))
then returnM (Succeeded (ghcPrimIface{ mi_package = base_pkg },
"<built in interface for GHC.Prim>"))
else do
-- Look for the file
; mb_found <- ioToIOEnv (findHiFile dflags explicit mod_name hi_boot_file)
; case mb_found of {
Left err -> do
Failed err -> do
{ traceIf (ptext SLIT("...not found"))
; dflags <- getDOpts
; returnM (Left (noIfaceErr dflags mod_name err)) } ;
; returnM (Failed (noIfaceErr dflags mod_name err)) } ;
Right (file_path,pkg) -> do
Succeeded (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
Failed err -> returnM (Failed (badIfaceFile file_path err))
Succeeded iface
| mi_module iface /= mod_name ->
return (Left (wrongIfaceModErr iface mod_name file_path))
return (Failed (wrongIfaceModErr iface mod_name file_path))
| otherwise ->
returnM (Right iface{mi_package=pkg})
-- don't forget to fill in the package name...
returnM (Succeeded (iface{mi_package=pkg}, file_path))
-- Don't forget to fill in the package name...
}}}
findHiFile :: DynFlags -> Bool -> Module -> IsBootInterface
-> IO (Either FindResult (FilePath, IfacePackage))
-> IO (MaybeErr FindResult (FilePath, PackageIdH))
findHiFile dflags explicit mod_name hi_boot_file
= do {
-- In interactive or --make mode, we are *not allowed* to demand-load
......@@ -607,35 +609,22 @@ findHiFile dflags explicit mod_name hi_boot_file
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))
}}
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)
}
\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
-> IfM lcl (MaybeErr Message ModIface)
-- 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
= do { dflags <- getDOpts
......@@ -645,13 +634,13 @@ 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))) ;
Left exn -> return (Failed (text (showException exn))) ;
Right buffer ->
case unP parseIface (mkPState buffer loc dflags) of
PFailed span err -> return (Left (mkLocMessage span err))
PFailed span err -> return (Failed (mkLocMessage span err))
POk _ iface
| wanted_mod == actual_mod -> return (Right iface)
| otherwise -> return (Left err)
| wanted_mod == actual_mod -> return (Succeeded iface)
| otherwise -> return (Failed err)
where
actual_mod = mi_module iface
err = hiModuleNameMismatchWarn wanted_mod actual_mod
......@@ -660,8 +649,8 @@ read_iface dflags wanted_mod file_path is_hi_boot_file
| otherwise -- Read binary
= do { res <- tryMost (readBinIface file_path)
; case res of
Right iface -> return (Right iface)
Left exn -> return (Left (text (showException exn))) }
Right iface -> return (Succeeded iface)
Left exn -> return (Failed (text (showException exn))) }
where
loc = mkSrcLoc (mkFastString file_path) 1 0
\end{code}
......@@ -691,7 +680,8 @@ initExternalPackageState
}
where
mk_gated_rule (fn_name, core_rule)
= ([fn_name], (nameModule fn_name, IfaceBuiltinRule (mkIfaceExtName fn_name) core_rule))
= ([fn_name], (nameModule fn_name, ptext SLIT("<built-in rule>"),
IfaceBuiltinRule (mkIfaceExtName fn_name) core_rule))
\end{code}
......@@ -704,7 +694,7 @@ initExternalPackageState
\begin{code}
ghcPrimIface :: ModIface
ghcPrimIface
= (emptyModIface ThisPackage gHC_PRIM) {
= (emptyModIface HomePackage gHC_PRIM) {
mi_exports = [(gHC_PRIM, ghcPrimExports)],
mi_decls = [],
mi_fixities = fixities,
......@@ -758,6 +748,7 @@ 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
......
......@@ -174,7 +174,7 @@ compiled with -O. I think this is the case.]
#include "HsVersions.h"
import HsSyn
import Packages ( isHomeModule )
import Packages ( isHomeModule, PackageIdH(..) )
import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..),
IfaceRule(..), IfaceInst(..), IfaceExtName(..), IfaceTyCon(..),
eqIfDecl, eqIfRule, eqIfInst, IfaceEq(..), (&&&), bool,
......@@ -185,7 +185,7 @@ import BasicTypes ( Version, initialVersion, bumpVersion )
import TcRnMonad
import TcRnTypes ( mkModDeps )
import TcType ( isFFITy )
import HscTypes ( ModIface(..), TyThing(..), IfacePackage(..),
import HscTypes ( ModIface(..), TyThing(..),
ModGuts(..), ModGuts, IfaceExport,
GhciMode(..), HscEnv(..), hscEPS,
Dependencies(..), FixItem(..),
......@@ -234,7 +234,8 @@ import FastString
import DATA_IOREF ( writeIORef )
import Monad ( when )
import List ( insert )
import Maybes ( orElse, mapCatMaybes, isNothing, isJust, fromJust, expectJust )
import Maybes ( orElse, mapCatMaybes, isNothing, isJust,
fromJust, expectJust, MaybeErr(..) )
\end{code}
......@@ -293,7 +294,7 @@ mkIface hsc_env location maybe_old_iface
; intermediate_iface = ModIface {
mi_module = this_mod,
mi_package = ThisPackage,
mi_package = HomePackage,
mi_boot = False,
mi_deps = deps,
mi_usages = usages,
......@@ -836,12 +837,12 @@ check_old_iface this_mod iface_path source_unchanged maybe_iface
-- from the .hi file left from the last time we compiled it
readIface this_mod iface_path False `thenM` \ read_result ->
case read_result of {
Left err -> -- Old interface file not found, or garbled; give up
Failed err -> -- Old interface file not found, or garbled; give up
traceIf (text "FYI: cannot read old interface file:"
$$ nest 4 err) `thenM_`
returnM (outOfDate, Nothing)
; Right iface ->
; Succeeded iface ->
-- We have got the old iface; check its versions
checkVersions source_unchanged iface `thenM` \ recomp ->
......@@ -908,13 +909,13 @@ checkModUsage (Usage { usg_name = mod_name, usg_mod = old_mod_vers,
-- Instead, get an Either back which we can test
case mb_iface of {
Left exn -> (out_of_date (sep [ptext SLIT("Can't find version number for module"),
Failed exn -> (out_of_date (sep [ptext SLIT("Can't find version number for module"),
ppr mod_name]));
-- Couldn't find or parse a module mentioned in the
-- old interface file. Don't complain -- it might just be that
-- the current module doesn't need that import and it's been deleted