[project @ 2001-02-23 14:59:26 by simonpj]

Fix a core-lint problem with -hi-boot files

3 files changed, 15 insertions, 8 deletions

diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index dff8e233b8..eea91a43e6 100644
--- a/ghc/compiler/main/HscTypes.lhs
+++ b/ghc/compiler/main/HscTypes.lhs
@@ -20,7 +20,7 @@ module HscTypes (
 	TyThing(..), isTyClThing, implicitTyThingIds,
 
 	TypeEnv, lookupType, mkTypeEnv, extendTypeEnvList, 
-	typeEnvClasses, typeEnvTyCons,
+	typeEnvClasses, typeEnvTyCons, typeEnvIds,
 
 	ImportedModuleInfo, WhetherHasOrphans, ImportVersion, WhatsImported(..),
 	PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
@@ -248,6 +248,7 @@ instance Outputable TyThing where
 
 typeEnvClasses env = [cl | AClass cl <- nameEnvElts env]
 typeEnvTyCons  env = [tc | ATyCon tc <- nameEnvElts env] 
+typeEnvIds     env = [id | AnId id   <- nameEnvElts env] 
 
 implicitTyThingIds :: [TyThing] -> [Id]
 -- Add the implicit data cons and selectors etc 
diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs
index b684d60e9d..cbd92f88c5 100644
--- a/ghc/compiler/typecheck/TcEnv.lhs
+++ b/ghc/compiler/typecheck/TcEnv.lhs
@@ -62,7 +62,9 @@ import Name		( Name, OccName, NamedThing(..),
 			)
 import Name		( NameEnv, lookupNameEnv, nameEnvElts, extendNameEnvList, emptyNameEnv )
 import OccName		( mkDFunOcc, occNameString )
-import HscTypes		( DFunId, TypeEnv, HomeSymbolTable, PackageTypeEnv )
+import HscTypes		( DFunId, TypeEnv, HomeSymbolTable, PackageTypeEnv,
+			  typeEnvTyCons, typeEnvClasses, typeEnvIds
+			)
 import Module		( Module )
 import InstEnv		( InstEnv, emptyInstEnv )
 import HscTypes		( lookupType, TyThing(..) )
@@ -156,9 +158,9 @@ initTcEnv syntax_map hst pte
 		| otherwise	   = lookupType hst pte name
 
 
-tcEnvClasses env = [cl | AClass cl <- nameEnvElts (tcGEnv env)]
-tcEnvTyCons  env = [tc | ATyCon tc <- nameEnvElts (tcGEnv env)] 
-tcEnvIds     env = [id | AnId   id <- nameEnvElts (tcGEnv env)] 
+tcEnvClasses env = typeEnvClasses (tcGEnv env)
+tcEnvTyCons  env = typeEnvTyCons  (tcGEnv env) 
+tcEnvIds     env = typeEnvIds     (tcGEnv env) 
 tcEnvTyVars  env = [tv | ATyVar tv <- nameEnvElts (tcLEnv env)]
 tcEnvTcIds   env = [id | ATcId  id <- nameEnvElts (tcLEnv env)]
 
diff --git a/ghc/compiler/typecheck/TcIfaceSig.lhs b/ghc/compiler/typecheck/TcIfaceSig.lhs
index e0fdf712da..256bcae5ad 100644
--- a/ghc/compiler/typecheck/TcIfaceSig.lhs
+++ b/ghc/compiler/typecheck/TcIfaceSig.lhs
@@ -12,7 +12,7 @@ import HsSyn		( TyClDecl(..), HsTupCon(..) )
 import TcMonad
 import TcMonoType	( tcIfaceType )
 import TcEnv		( TcEnv, RecTcEnv, tcExtendTyVarEnv, 
-			  tcExtendGlobalValEnv, tcSetEnv,
+			  tcExtendGlobalValEnv, tcSetEnv, tcEnvIds,
 			  tcLookupGlobal_maybe, tcLookupRecId_maybe
 			)
 
@@ -25,7 +25,7 @@ import CoreUnfold
 import CoreLint		( lintUnfolding )
 import WorkWrap		( mkWrapper )
 
-import Id		( Id, mkId, mkVanillaId, isDataConWrapId_maybe )
+import Id		( Id, mkId, mkVanillaId, isLocalId, isDataConWrapId_maybe )
 import MkId		( mkCCallOpId )
 import IdInfo
 import DataCon		( DataCon, dataConId, dataConSig, dataConArgTys )
@@ -57,7 +57,11 @@ tcInterfaceSigs unf_env decls
   = listTc [ do_one name ty id_infos src_loc
 	   | IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc =src_loc} <- decls]
   where
-    in_scope_vars = []	-- I think this will be OK
+    in_scope_vars = filter isLocalId (tcEnvIds unf_env)
+	-- When we have hi-boot files, an unfolding might refer to
+	-- something defined in this module, so we must build a
+	-- suitable in-scope set.  This thunk will only be poked
+	-- if -dcore-lint is on.
 
     do_one name ty id_infos src_loc
       = tcAddSrcLoc src_loc 		 		$