Commit 18b24e64 authored by simonmar's avatar simonmar
Browse files

[project @ 2001-03-01 14:26:00 by simonmar]

GHCi fixes:

  - expressions are now compiled in a pseudo-module "$Interactive",
    which avoids some problems with storage of demand-loaded declarations.

  - compilation manager now detects when it needs to read the interace
    for a module, even if it is already compiled.  GHCi never demand-loads
    interfaces now.

  - (from Simon PJ) fix a problem with the recompilation checker, which
    meant that modules were sometimes not recompiled when they should
    have been.

  - ByteCodeGen/Link: move linker related stuff into ByteCodeLink.
parent 6ae3188b
......@@ -20,6 +20,7 @@ module CmLink ( Linkable(..), Unlinked(..),
import Interpreter
import DriverPipeline
import ByteCodeLink ( linkIModules, linkIExpr )
import CmTypes
import CmStaticInfo ( GhciMode(..) )
import Outputable ( SDoc )
......
......@@ -50,8 +50,7 @@ import VarEnv ( emptyTidyEnv )
import HscTypes
import HscMain ( initPersistentCompilerState )
import Finder
import UniqFM ( lookupUFM, addToUFM, delListFromUFM,
UniqFM, listToUFM )
import UniqFM
import Unique ( Uniquable )
import Digraph ( SCC(..), stronglyConnComp, flattenSCC )
import DriverFlags ( getDynFlags )
......@@ -233,7 +232,7 @@ cmTypeOfExpr cmstate dflags expr
case names of
[name] -> do maybe_tystr <- cmTypeOfName new_cmstate name
return (new_cmstate, maybe_tystr)
_other -> pprPanic "cmTypeOfExpr" (ppr names)
_other -> return (new_cmstate, Nothing)
#endif
-----------------------------------------------------------------------------
......@@ -347,9 +346,6 @@ cmLoadModule cmstate1 rootname
let ghci_mode = gmode cmstate1 -- this never changes
-- Do the downsweep to reestablish the module graph
-- then generate version 2's by retaining in HIT,HST,UI a
-- stable set S of modules, as defined below.
dflags <- getDynFlags
let verb = verbosity dflags
......@@ -387,8 +383,8 @@ cmLoadModule cmstate1 rootname
-- 1. All home imports of ms are either in ms or S
-- 2. A valid linkable exists for each module in ms
stable_mods
<- preUpsweep valid_linkables mg2unsorted_names [] mg2_with_srcimps
stable_mods <- preUpsweep valid_linkables hit1
mg2unsorted_names [] mg2_with_srcimps
let stable_summaries
= concatMap (findInSummaries mg2unsorted) stable_mods
......@@ -585,10 +581,6 @@ getValidLinkable :: [Linkable] -> Bool -> [Linkable] -> ModSummary
getValidLinkable old_linkables objects_allowed new_linkables summary
= do let mod_name = name_of_summary summary
-- we only look for objects on disk the first time around;
-- if the user compiles a module on the side during a GHCi session,
-- it won't be picked up until the next ":load". This is what the
-- "null old_linkables" test below is.
maybe_disk_linkable
<- if (not objects_allowed)
then return Nothing
......@@ -612,6 +604,10 @@ getValidLinkable old_linkables objects_allowed new_linkables summary
Nothing -> False
Just l_disk -> linkableTime l == linkableTime l_disk
-- we only look for objects on disk the first time around;
-- if the user compiles a module on the side during a GHCi session,
-- it won't be picked up until the next ":load". This is what the
-- "null old_linkables" test below is.
linkable | null old_linkables = maybeToList maybe_disk_linkable
| otherwise = maybeToList maybe_old_linkable
......@@ -647,14 +643,20 @@ maybe_getFileLinkable mod_name obj_fn
-- Do a pre-upsweep without use of "compile", to establish a
-- (downward-closed) set of stable modules for which we won't call compile.
-- a stable module:
-- * has a valid linkable (see getValidLinkables above)
-- * depends only on stable modules
-- * has an interface in the HIT (interactive mode only)
preUpsweep :: [Linkable] -- new valid linkables
-> HomeIfaceTable
-> [ModuleName] -- names of all mods encountered in downsweep
-> [ModuleName] -- accumulating stable modules
-> [SCC ModSummary] -- scc-ified mod graph, including src imps
-> IO [ModuleName] -- stable modules
preUpsweep valid_lis all_home_mods stable [] = return stable
preUpsweep valid_lis all_home_mods stable (scc0:sccs)
preUpsweep valid_lis hit all_home_mods stable [] = return stable
preUpsweep valid_lis hit all_home_mods stable (scc0:sccs)
= do let scc = flattenSCC scc0
scc_allhomeimps :: [ModuleName]
scc_allhomeimps
......@@ -672,14 +674,15 @@ preUpsweep valid_lis all_home_mods stable (scc0:sccs)
= isJust (findModuleLinkable_maybe valid_lis modname)
where modname = name_of_summary new_summary
has_interface summary = ms_mod summary `elemUFM` hit
scc_is_stable = all_imports_in_scc_or_stable
&& all has_valid_linkable scc
&& all has_interface scc
if scc_is_stable
then preUpsweep valid_lis all_home_mods (scc_names++stable) sccs
else preUpsweep valid_lis all_home_mods stable sccs
where
then preUpsweep valid_lis hit all_home_mods (scc_names++stable) sccs
else preUpsweep valid_lis hit all_home_mods stable sccs
-- Helper for preUpsweep. Assuming that new_summary's imports are all
......
......@@ -6,8 +6,7 @@
\begin{code}
module ByteCodeGen ( UnlinkedBCO, UnlinkedBCOExpr, ItblEnv, ClosureEnv, HValue,
filterNameMap,
byteCodeGen, coreExprToBCOs,
linkIModules, linkIExpr
byteCodeGen, coreExprToBCOs
) where
#include "HsVersions.h"
......@@ -44,7 +43,7 @@ import PprType ( pprType )
import ByteCodeInstr ( BCInstr(..), ProtoBCO(..), nameOfProtoBCO, bciStackUse )
import ByteCodeItbls ( ItblEnv, mkITbls )
import ByteCodeLink ( UnlinkedBCO, UnlinkedBCOExpr, assembleBCO,
ClosureEnv, HValue, linkSomeBCOs, filterNameMap,
ClosureEnv, HValue, filterNameMap,
iNTERP_STACK_CHECK_THRESH )
import List ( intersperse, sortBy )
......@@ -122,27 +121,6 @@ coreExprToBCOs dflags expr
root_bco <- assembleBCO root_proto_bco
return (root_bco, auxiliary_bcos)
-- Linking stuff
linkIModules :: ItblEnv -- incoming global itbl env; returned updated
-> ClosureEnv -- incoming global closure env; returned updated
-> [([UnlinkedBCO], ItblEnv)]
-> IO ([HValue], ItblEnv, ClosureEnv)
linkIModules gie gce mods
= do let (bcoss, ies) = unzip mods
bcos = concat bcoss
final_gie = foldr plusFM gie ies
(final_gce, linked_bcos) <- linkSomeBCOs True final_gie gce bcos
return (linked_bcos, final_gie, final_gce)
linkIExpr :: ItblEnv -> ClosureEnv -> UnlinkedBCOExpr
-> IO HValue -- IO BCO# really
linkIExpr ie ce (root_ul_bco, aux_ul_bcos)
= do (aux_ce, _) <- linkSomeBCOs False ie ce aux_ul_bcos
(_, [root_bco]) <- linkSomeBCOs False ie aux_ce [root_ul_bco]
return root_bco
\end{code}
%************************************************************************
......
......@@ -5,7 +5,8 @@
\begin{code}
module ByteCodeLink ( UnlinkedBCO, UnlinkedBCOExpr, assembleBCO,
ClosureEnv, HValue, linkSomeBCOs, filterNameMap,
ClosureEnv, HValue, filterNameMap,
linkIModules, linkIExpr,
iNTERP_STACK_CHECK_THRESH
) where
......@@ -38,6 +39,7 @@ import MArray ( castSTUArray,
newAddrArray, writeAddrArray )
import Foreign ( Word16, Ptr(..) )
import Addr ( Word, Addr, nullAddr )
import FiniteMap
import PrelBase ( Int(..) )
import PrelGHC ( BCO#, newBCO#, unsafeCoerce#,
......@@ -56,6 +58,25 @@ import PrelIOBase ( IO(..) )
%************************************************************************
\begin{code}
-- Linking stuff
linkIModules :: ItblEnv -- incoming global itbl env; returned updated
-> ClosureEnv -- incoming global closure env; returned updated
-> [([UnlinkedBCO], ItblEnv)]
-> IO ([HValue], ItblEnv, ClosureEnv)
linkIModules gie gce mods
= do let (bcoss, ies) = unzip mods
bcos = concat bcoss
final_gie = foldr plusFM gie ies
(final_gce, linked_bcos) <- linkSomeBCOs True final_gie gce bcos
return (linked_bcos, final_gie, final_gce)
linkIExpr :: ItblEnv -> ClosureEnv -> UnlinkedBCOExpr
-> IO HValue -- IO BCO# really
linkIExpr ie ce (root_ul_bco, aux_ul_bcos)
= do (aux_ce, _) <- linkSomeBCOs False ie ce aux_ul_bcos
(_, [root_bco]) <- linkSomeBCOs False ie aux_ce [root_ul_bco]
return root_bco
-- Link a bunch of BCOs and return them + updated closure env.
linkSomeBCOs :: Bool -- False <=> add _all_ BCOs to returned closure env
......@@ -74,7 +95,10 @@ linkSomeBCOs toplevs_only ie ce_in ul_bcos
ce_top_additions = filter (isGlobalName.fst) ce_all_additions
ce_additions = if toplevs_only then ce_top_additions
else ce_all_additions
ce_out = addListToFM ce_in ce_additions
ce_out = -- make sure we're not inserting duplicate names into the
-- closure environment, which leads to trouble.
ASSERT (all (not . (`elemFM` ce_in)) (map fst ce_additions))
addListToFM ce_in ce_additions
return (ce_out, hvals)
where
-- A lazier zip, in which no demand is propagated to the second
......
......@@ -31,7 +31,7 @@ import SrcLoc ( mkSrcLoc )
import Rename ( checkOldIface, renameModule, closeIfaceDecls )
import Rules ( emptyRuleBase )
import PrelInfo ( wiredInThingEnv, wiredInThings )
import PrelNames ( vanillaSyntaxMap, knownKeyNames )
import PrelNames ( vanillaSyntaxMap, knownKeyNames, iNTERACTIVE )
import MkIface ( completeIface, mkModDetailsFromIface, mkModDetails,
writeIface, pprIface )
import TcModule
......@@ -452,9 +452,9 @@ A naked expression returns a singleton Name [it].
hscStmt dflags hst hit pcs0 icontext stmt
= let
InteractiveContext {
ic_rn_env = rn_env,
ic_rn_env = rn_env,
ic_type_env = type_env,
ic_module = this_mod } = icontext
ic_module = scope_mod } = icontext
in
do { maybe_stmt <- hscParseStmt dflags stmt
; case maybe_stmt of
......@@ -463,20 +463,23 @@ hscStmt dflags hst hit pcs0 icontext stmt
-- Rename it
(pcs1, print_unqual, maybe_renamed_stmt)
<- renameStmt dflags hit hst pcs0 this_mod rn_env parsed_stmt
<- renameStmt dflags hit hst pcs0 scope_mod
iNTERACTIVE rn_env parsed_stmt
; case maybe_renamed_stmt of
Nothing -> return (pcs0, Nothing)
Just (bound_names, rn_stmt) -> do {
-- Typecheck it
maybe_tc_return <- typecheckStmt dflags pcs1 hst type_env
print_unqual this_mod bound_names rn_stmt
maybe_tc_return
<- typecheckStmt dflags pcs1 hst type_env
print_unqual iNTERACTIVE bound_names rn_stmt
; case maybe_tc_return of {
Nothing -> return (pcs0, Nothing) ;
Just (pcs2, tc_expr, bound_ids) -> do {
-- Desugar it
ds_expr <- deSugarExpr dflags pcs2 hst this_mod print_unqual tc_expr
ds_expr <- deSugarExpr dflags pcs2 hst iNTERACTIVE print_unqual tc_expr
-- Simplify it
; simpl_expr <- simplifyExpr dflags pcs2 hst ds_expr
......
......@@ -18,7 +18,7 @@ module HscTypes (
IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
VersionInfo(..), initialVersionInfo,
VersionInfo(..), initialVersionInfo, lookupVersion,
TyThing(..), isTyClThing, implicitTyThingIds,
......@@ -74,7 +74,7 @@ import CoreSyn ( IdCoreRule )
import FiniteMap ( FiniteMap )
import Bag ( Bag )
import Maybes ( seqMaybe )
import Maybes ( seqMaybe, orElse )
import Outputable
import SrcLoc ( SrcLoc, isGoodSrcLoc )
import Util ( thenCmp, sortLt )
......@@ -339,13 +339,19 @@ data VersionInfo
-- The version of an Id changes if its fixity changes
-- Ditto data constructors, class operations, except that the version of
-- the parent class/tycon changes
--
-- If a name isn't in the map, it means 'initialVersion'
}
initialVersionInfo :: VersionInfo
initialVersionInfo = VersionInfo { vers_module = initialVersion,
vers_exports = initialVersion,
vers_rules = initialVersion,
vers_decls = emptyNameEnv }
vers_decls = emptyNameEnv
}
lookupVersion :: NameEnv Version -> Name -> Version
lookupVersion env name = lookupNameEnv env name `orElse` initialVersion
data Deprecations = NoDeprecs
| DeprecAll DeprecTxt -- Whole module deprecated
......
......@@ -6,7 +6,7 @@
\begin{code}
module MkIface (
mkModDetails, mkModDetailsFromIface, completeIface,
writeIface, pprIface
writeIface, pprIface, pprUsage
) where
#include "HsVersions.h"
......@@ -25,7 +25,7 @@ import HscTypes ( VersionInfo(..), ModIface(..), ModDetails(..),
TyThing(..), DFunId, TypeEnv, Avails,
WhatsImported(..), GenAvailInfo(..),
ImportVersion, AvailInfo, Deprecations(..),
extendTypeEnvList
extendTypeEnvList, lookupVersion,
)
import CmdLineOpts
......@@ -54,6 +54,7 @@ import Type ( splitSigmaTy, tidyTopType, deNoteType )
import SrcLoc ( noSrcLoc )
import Outputable
import Module ( ModuleName )
import Maybes ( orElse )
import IO ( IOMode(..), openFile, hClose )
\end{code}
......@@ -381,7 +382,8 @@ addVersionInfo (Just old_iface@(ModIface { mi_version = old_version,
where
final_iface = new_iface { mi_version = new_version }
new_version = VersionInfo { vers_module = bumpVersion no_output_change (vers_module old_version),
old_mod_vers = vers_module old_version
new_version = VersionInfo { vers_module = bumpVersion no_output_change old_mod_vers,
vers_exports = bumpVersion no_export_change (vers_exports old_version),
vers_rules = bumpVersion no_rule_change (vers_rules old_version),
vers_decls = tc_vers }
......@@ -396,8 +398,7 @@ addVersionInfo (Just old_iface@(ModIface { mi_version = old_version,
-- Fill in the version number on the new declarations by looking at the old declarations.
-- Set the flag if anything changes.
-- Assumes that the decls are sorted by hsDeclName.
old_vers_decls = vers_decls old_version
(no_tc_change, pp_tc_diffs, tc_vers) = diffDecls old_vers_decls old_fixities new_fixities
(no_tc_change, pp_tc_diffs, tc_vers) = diffDecls old_version old_fixities new_fixities
(dcl_tycl old_decls) (dcl_tycl new_decls)
pp_diffs = vcat [pp_tc_diffs,
pp_change no_export_change "Export list",
......@@ -407,14 +408,15 @@ addVersionInfo (Just old_iface@(ModIface { mi_version = old_version,
pp_change True what = empty
pp_change False what = text what <+> ptext SLIT("changed")
diffDecls :: NameEnv Version -- Old version map
diffDecls :: VersionInfo -- Old version
-> NameEnv Fixity -> NameEnv Fixity -- Old and new fixities
-> [RenamedTyClDecl] -> [RenamedTyClDecl] -- Old and new decls
-> (Bool, -- True <=> no change
SDoc, -- Record of differences
NameEnv Version) -- New version
NameEnv Version) -- New version map
diffDecls old_vers old_fixities new_fixities old new
diffDecls (VersionInfo { vers_module = old_mod_vers, vers_decls = old_decls_vers })
old_fixities new_fixities old new
= diff True empty emptyNameEnv old new
where
-- When seeing if two decls are the same,
......@@ -423,19 +425,26 @@ diffDecls old_vers old_fixities new_fixities old new
same_fixity n = lookupNameEnv old_fixities n == lookupNameEnv new_fixities n
diff ok_so_far pp new_vers [] [] = (ok_so_far, pp, new_vers)
diff ok_so_far pp new_vers (od:ods) [] = diff False (pp $$ only_old od) new_vers ods []
diff ok_so_far pp new_vers [] (nd:nds) = diff False (pp $$ only_new nd) new_vers [] nds
diff ok_so_far pp new_vers (od:ods) [] = diff False (pp $$ only_old od) new_vers ods []
diff ok_so_far pp new_vers [] (nd:nds) = diff False (pp $$ only_new nd) new_vers_with_new [] nds
where
new_vers_with_new = extendNameEnv new_vers (tyClDeclName nd) (bumpVersion False old_mod_vers)
-- When adding a new item, start from the old module version
-- This way, if you have version 4 of f, then delete f, then add f again,
-- you'll get version 6 of f, which will (correctly) force recompilation of
-- clients
diff ok_so_far pp new_vers (od:ods) (nd:nds)
= case od_name `compare` nd_name of
LT -> diff False (pp $$ only_old od) new_vers ods (nd:nds)
GT -> diff False (pp $$ only_new nd) new_vers (od:ods) nds
EQ | od `eq_tc` nd -> diff ok_so_far pp new_vers ods nds
| otherwise -> diff False (pp $$ changed od nd) new_vers' ods nds
EQ | od `eq_tc` nd -> diff ok_so_far pp new_vers ods nds
| otherwise -> diff False (pp $$ changed od nd) new_vers_with_diff ods nds
where
od_name = tyClDeclName od
nd_name = tyClDeclName nd
new_vers' = extendNameEnv new_vers nd_name
(bumpVersion False (lookupNameEnv_NF old_vers od_name))
new_vers_with_diff = extendNameEnv new_vers nd_name (bumpVersion False old_version)
old_version = lookupVersion old_decls_vers od_name
only_old d = ptext SLIT("Only in old iface:") <+> ppr d
only_new d = ptext SLIT("Only in new iface:") <+> ppr d
......
......@@ -30,6 +30,7 @@ import RnIfaces ( slurpImpDecls, mkImportInfo, recordLocalSlurps,
import RnHiFiles ( readIface, removeContext, loadInterface,
loadExports, loadFixDecls, loadDeprecs,
)
import MkIface ( pprUsage )
import RnEnv ( availsToNameSet, mkIfaceGlobalRdrEnv,
emptyAvailEnv, unitAvailEnv, availEnvElts,
plusAvailEnv, groupAvails, warnUnusedImports,
......@@ -97,7 +98,8 @@ renameModule dflags hit hst pcs this_module rdr_module
renameStmt :: DynFlags
-> HomeIfaceTable -> HomeSymbolTable
-> PersistentCompilerState
-> Module -- current context (module)
-> Module -- current context (scope to compile in)
-> Module -- current module
-> LocalRdrEnv -- current context (temp bindings)
-> RdrNameStmt -- parsed stmt
-> IO ( PersistentCompilerState,
......@@ -105,13 +107,13 @@ renameStmt :: DynFlags
Maybe ([Name], (SyntaxMap, RenamedStmt, [RenamedHsDecl]))
)
renameStmt dflags hit hst pcs this_module local_env stmt
renameStmt dflags hit hst pcs scope_module this_module local_env stmt
= renameSource dflags hit hst pcs this_module $
-- Load the interface for the context module, so
-- that we can get its top-level lexical environment
-- Bale out if we fail to do this
loadInterface doc (moduleName this_module) ImportByUser `thenRn` \ iface ->
loadInterface doc (moduleName scope_module) ImportByUser `thenRn` \ iface ->
let rdr_env = mi_globals iface
print_unqual = unQualInScope rdr_env
in
......@@ -245,6 +247,7 @@ rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec
-- GENERATE THE VERSION/USAGE INFO
mkImportInfo mod_name imports `thenRn` \ my_usages ->
traceHiDiffsRn (vcat (map pprUsage my_usages)) `thenRn_`
-- BUILD THE MODULE INTERFACE
let
......
......@@ -38,8 +38,7 @@ import Id ( idType )
import Type ( namesOfType )
import TyCon ( isSynTyCon, getSynTyConDefn )
import Name ( Name {-instance NamedThing-}, nameOccName,
nameModule, isLocalName, isHomePackageName,
NamedThing(..)
nameModule, isLocalName, NamedThing(..)
)
import Name ( elemNameEnv, delFromNameEnv )
import Module ( Module, ModuleEnv,
......@@ -169,8 +168,7 @@ mkImportInfo this_mod imports
-- The sort is to put them into canonical order
mk_import_items ns = [(n,v) | n <- sortLt lt_occ ns,
let v = lookupNameEnv version_env n `orElse`
pprPanic "mk_whats_imported" (ppr n)
let v = lookupVersion version_env n
]
where
lt_occ n1 n2 = nameOccName n1 < nameOccName n2
......@@ -302,22 +300,26 @@ rnIfaceTyClDecl (mod, decl) = initIfaceRnMS mod (rnTyClDecl decl) `thenRn` \ dec
\begin{code}
recordSlurp ifaces@(Ifaces { iDecls = (decls_map, n_slurped),
iSlurp = slurped_names,
iVSlurp = (imp_mods, imp_names) })
recordDeclSlurp ifaces@(Ifaces { iDecls = (decls_map, n_slurped),
iSlurp = slurped_names,
iVSlurp = vslurp })
avail
= ASSERT2( not (isLocalName (availName avail)), ppr avail )
ifaces { iDecls = (decls_map', n_slurped+1),
ifaces { iDecls = (new_decls_map, n_slurped+1),
iSlurp = new_slurped_names,
iVSlurp = new_vslurp }
iVSlurp = updateVSlurp vslurp (availName avail) }
where
decls_map' = foldl delFromNameEnv decls_map (availNames avail)
main_name = availName avail
new_decls_map = foldl delFromNameEnv decls_map (availNames avail)
new_slurped_names = addAvailToNameSet slurped_names avail
new_vslurp | isHomePackageName main_name = (imp_mods, addOneToNameSet imp_names main_name)
| otherwise = (extendModuleSet imp_mods mod, imp_names)
mod = nameModule main_name
recordVSlurp ifaces name = ifaces { iVSlurp = updateVSlurp (iVSlurp ifaces) name }
updateVSlurp (imp_mods, imp_names) main_name
| isHomeModule mod = (imp_mods, addOneToNameSet imp_names main_name)
| otherwise = (extendModuleSet imp_mods mod, imp_names)
where
mod = nameModule main_name
recordLocalSlurps new_names
= getIfacesRn `thenRn` \ ifaces ->
setIfacesRn (ifaces { iSlurp = iSlurp ifaces `unionNameSets` new_names })
......@@ -569,17 +571,25 @@ importDecl name
returnRn AlreadySlurped
else
-- STEP 2: Check if it's already in the type environment
getTypeEnvRn `thenRn` \ lookup ->
case lookup name of {
Just ty_thing | name `elemNameEnv` wiredInThingEnv
-> -- When we find a wired-in name we must load its home
-- module so that we find any instance decls lurking therein
loadHomeInterface wi_doc name `thenRn_`
returnRn (InTypeEnv ty_thing)
| otherwise
-> returnRn (InTypeEnv ty_thing) ;
Just ty_thing
| name `elemNameEnv` wiredInThingEnv
-> -- When we find a wired-in name we must load its home
-- module so that we find any instance decls lurking therein
loadHomeInterface wi_doc name `thenRn_`
returnRn (InTypeEnv ty_thing)
| otherwise
-> -- Record that we use this thing. We must do this
-- regardless of whether we need to demand-slurp it in
-- or we already have it in the type environment. Why?
-- because the slurp information is used to generate usage
-- information in the interface.
setIfacesRn (recordVSlurp ifaces (getName ty_thing)) `thenRn_`
returnRn (InTypeEnv ty_thing) ;
Nothing ->
......@@ -594,13 +604,11 @@ importDecl name
(decls_map, _) = iDecls ifaces
in
case lookupNameEnv decls_map name of
Just (avail,_,decl)
-> setIfacesRn (recordSlurp ifaces avail) `thenRn_`
returnRn (HereItIs decl)
Just (avail,_,decl) -> setIfacesRn (recordDeclSlurp ifaces avail) `thenRn_`
returnRn (HereItIs decl)
Nothing
-> addErrRn (getDeclErr name) `thenRn_`
returnRn AlreadySlurped
Nothing -> addErrRn (getDeclErr name) `thenRn_`
returnRn AlreadySlurped
}
where
wi_doc = ptext SLIT("need home module for wired in thing") <+> ppr name
......@@ -670,6 +678,7 @@ checkModUsage (mod_name, _, is_boot, whats_imported)
from | is_boot = ImportByUserSource
| otherwise = ImportByUser
in
traceHiDiffsRn (text "Checking usages for module" <+> ppr mod_name) `thenRn_`
tryLoadInterface doc_str mod_name from `thenRn` \ (iface, maybe_err) ->
case maybe_err of {
......@@ -739,7 +748,7 @@ checkEntityUsage new_vers (name,old_vers)
out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
Just new_vers -- It's there, but is it up to date?
| new_vers == old_vers -> returnRn upToDate
| new_vers == old_vers -> traceHiDiffsRn (text "Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenRn_` returnRn upToDate
| otherwise -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name])
up_to_date msg = traceHiDiffsRn msg `thenRn_` returnRn upToDate
......
......@@ -55,7 +55,7 @@ import Type ( funResultTy, splitForAllTys,
liftedTypeKind, mkTyConApp, tidyType )
import ErrUtils ( printErrorsAndWarnings, errorsFound, dumpIfSet_dyn, showPass )
import Id ( Id, idType, idName, isLocalId, idUnfolding )
import Module ( Module, isHomeModule, moduleName )
import Module ( Module, moduleName )
import Name ( Name, toRdrName, isGlobalName )
import Name ( nameEnvElts, lookupNameEnv )
import TyCon ( tyConGenInfo )
......@@ -482,11 +482,8 @@ tcImports unf_env pcs hst get_fixity this_mod decls
-- (on the GHCi command line, for example). In this case, we
-- want to treat everything we pulled in as an imported thing.
imported_things
| isHomeModule this_mod
= filter (not . isLocalThing this_mod) all_things
| otherwise
= all_things
= filter (not . isLocalThing this_mod) all_things
new_pte :: PackageTypeEnv
new_pte = extendTypeEnvList (pcs_PTE pcs) imported_things
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment