[project @ 2005-01-27 11:50:58 by simonpj]

Make sure that the interactive context can see home-package instances;
I forgot to do this when making tcRnModule find the appropriate intances
(TcRnDriver rev 1.91)

This was causing SourceForge [ghc-Bugs-1106171].

diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index 97df435..0f1a708 100644 (file)
--- a/ghc/compiler/main/HscTypes.lhs
+++ b/ghc/compiler/main/HscTypes.lhs
@@ -195,29 +195,16 @@ lookupIfaceByModule hpt pit mod
 
 
 \begin{code}
-hptInstances :: HscEnv -> [(Module, IsBootInterface)] -> [DFunId]
+hptInstances :: HscEnv -> (Module -> Bool) -> [DFunId]
 -- Find all the instance declarations that are in modules imported 
 -- by this one, directly or indirectly, and are in the Home Package Table
 -- This ensures that we don't see instances from modules --make compiled 
 -- before this one, but which are not below this one
-hptInstances hsc_env deps
-  | isOneShot (hsc_mode hsc_env) = []  -- In one-shot mode, the HPT is empty
-  | otherwise
-  = let 
-       hpt = hsc_HPT hsc_env
-    in
-    [ dfun 
-    |  -- Find each non-hi-boot module below me
-      (mod, False) <- deps
-
-       -- Look it up in the HPT
-    , let mod_info = ASSERT2( mod `elemModuleEnv` hpt, ppr mod $$ vcat (map ppr_hm (moduleEnvElts hpt)))
-                    fromJust (lookupModuleEnv hpt mod)
-
-       -- And get its dfuns
+hptInstances hsc_env want_this_module
+  = [ dfun 
+    | mod_info <- moduleEnvElts (hsc_HPT hsc_env)
+    , want_this_module (mi_module (hm_iface mod_info))
     , dfun <- md_insts (hm_details mod_info) ]
-  where
-   ppr_hm hm = ppr (mi_module (hm_iface hm))
 
 hptRules :: HscEnv -> [(Module, IsBootInterface)] -> [IdCoreRule]
 -- Get rules from modules "below" this one (in the dependency sense)

diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index 5bd681a..9abaa9e 100644 (file)
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -59,7 +59,7 @@ import ErrUtils               ( Messages, mkDumpDoc, showPass )
 import Id              ( mkExportedLocalId, isLocalId, idName, idType )
 import Var             ( Var )
 import VarEnv          ( varEnvElts )
-import Module           ( Module, ModuleEnv, mkModule, moduleEnvElts )
+import Module           ( Module, ModuleEnv, mkModule, moduleEnvElts, lookupModuleEnv )
 import OccName         ( mkVarOcc )
 import Name            ( Name, isExternalName, getSrcLoc, getOccName, isWiredInName )
 import NameSet
@@ -120,7 +120,6 @@ import Var          ( globaliseId )
 import Name            ( nameOccName, nameModule )
 import NameEnv         ( delListFromNameEnv )
 import PrelNames       ( iNTERACTIVE, ioTyConName, printName, monadNames, itName, returnIOName )
-import Module          ( lookupModuleEnv )
 import HscTypes                ( InteractiveContext(..), HomeModInfo(..), typeEnvElts, typeEnvClasses,
                          availNames, availName, ModIface(..), icPrintUnqual,
                          ModDetails(..), Dependencies(..) )
@@ -169,16 +168,22 @@ tcRnModule hsc_env hsc_src (L loc (HsModule maybe_mod export_ies
                -- Deal with imports; sets tcg_rdr_env, tcg_imports
        (rdr_env, imports) <- rnImports import_decls ;
 
+       let { dep_mods :: ModuleEnv (Module, IsBootInterface)
+           ; dep_mods = imp_dep_mods imports
+
+           ; is_dep_mod :: Module -> Bool
+           ; is_dep_mod mod = case lookupModuleEnv dep_mods mod of
+                               Nothing           -> False
+                               Just (_, is_boot) -> not is_boot 
+           ; home_insts = hptInstances hsc_env is_dep_mod
+           } ;
+
                -- Record boot-file info in the EPS, so that it's 
                -- visible to loadHiBootInterface in tcRnSrcDecls,
                -- and any other incrementally-performed imports
-       let { dep_mods :: ModuleEnv (Module, IsBootInterface)
-           ; dep_mods = imp_dep_mods imports } ;
-
        updateEps_ (\eps -> eps { eps_is_boot = dep_mods }) ;
 
                -- Update the gbl env
-       let { home_insts = hptInstances hsc_env (moduleEnvElts dep_mods) } ;
        updGblEnv ( \ gbl -> 
                gbl { tcg_rdr_env  = rdr_env,
                      tcg_inst_env = extendInstEnvList (tcg_inst_env gbl) home_insts,
@@ -767,9 +772,10 @@ check_main ghci_mode tcg_env main_mod main_fn
 setInteractiveContext :: HscEnv -> InteractiveContext -> TcRn a -> TcRn a
 setInteractiveContext hsc_env icxt thing_inside 
   = let 
-       root_modules :: [(Module, IsBootInterface)]
-       root_modules = [(mkModule m, False) | m <- ic_toplev_scope icxt]
-       dfuns        = hptInstances hsc_env root_modules
+       -- Initialise the tcg_inst_env with instances 
+       -- from all home modules.  This mimics the more selective
+       -- call to hptInstances in tcRnModule
+       dfuns = hptInstances hsc_env (\mod -> True)
     in
     updGblEnv (\env -> env { 
        tcg_rdr_env  = ic_rn_gbl_env icxt,