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

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

diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index dff8e23..eea91a4 100644 (file)
--- 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 b684d60..cbd92f8 100644 (file)
--- 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 e0fdf71..256bcae 100644 (file)
--- 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                            $