From 281bcf70ef27e49f4b0c22ce56f93fa924d6ccbd Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Thu, 27 Jan 2005 11:51:00 +0000
Subject: [PATCH] [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].
---
 ghc/compiler/main/HscTypes.lhs        |   23 +++++------------------
 ghc/compiler/typecheck/TcRnDriver.lhs |   24 +++++++++++++++---------
 2 files changed, 20 insertions(+), 27 deletions(-)

diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index 97df435..0f1a708 100644
--- 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
--- 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,
-- 
1.7.10.4