From 4d5d91aabe3178eb92342e39d9eedc244f5f6f5a Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Mon, 2 May 2005 13:08:39 +0000
Subject: [PATCH] [project @ 2005-05-02 13:08:38 by simonpj] In the :i command
 for ghci, load the interface files for the home module of
 every in-scope type or class. That way we are sure to see
 all their instance declarations.

	MERGE TO STABLE branch
---
 ghc/compiler/iface/LoadIface.lhs      |    4 ++--
 ghc/compiler/typecheck/TcRnDriver.lhs |   33 +++++++++++++++++++++++++++------
 2 files changed, 29 insertions(+), 8 deletions(-)

diff --git a/ghc/compiler/iface/LoadIface.lhs b/ghc/compiler/iface/LoadIface.lhs
index 15217b8..70e09c9 100644
--- a/ghc/compiler/iface/LoadIface.lhs
+++ b/ghc/compiler/iface/LoadIface.lhs
@@ -5,8 +5,8 @@
 
 \begin{code}
 module LoadIface (
-	loadHomeInterface, loadInterface, loadWiredInHomeIface, 
-	loadSrcInterface, loadOrphanModules, 
+	loadInterface, loadHomeInterface, loadWiredInHomeIface, 
+	loadSrcInterface, loadSysInterface, loadOrphanModules, 
 	findAndReadIface, readIface,	-- Used when reading the module's old interface
 	loadDecls, ifaceStats, discardDeclPrags,
 	initExternalPackageState
diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index 44964ec..09ac7b4 100644
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -87,8 +87,8 @@ import HsSyn		( HsStmtContext(..), Stmt(..), HsExpr(..), HsBindGroup(..),
 			  collectLStmtsBinders, mkSimpleMatch, nlVarPat,
 		   	  placeHolderType, noSyntaxExpr )
 import RdrName		( GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..),
-			  Provenance(..), ImportSpec(..),
-			  lookupLocalRdrEnv, extendLocalRdrEnv )
+			  Provenance(..), ImportSpec(..), globalRdrEnvElts,
+			  unQualOK, lookupLocalRdrEnv, extendLocalRdrEnv )
 import RnSource		( addTcgDUs )
 import TcHsSyn		( mkHsLet, zonkTopLExpr, zonkTopBndrs )
 import TcHsType		( kcHsType )
@@ -102,16 +102,16 @@ import RnTypes		( rnLHsType )
 import Inst		( tcGetInstEnvs )
 import InstEnv		( classInstances, instEnvElts )
 import RnExpr		( rnStmts, rnLExpr )
-import LoadIface	( loadSrcInterface )
+import LoadIface	( loadSrcInterface, loadSysInterface )
 import IfaceSyn		( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), 
 			  IfaceExtName(..), IfaceConDecls(..), 
 			  tyThingToIfaceDecl )
 import IfaceType	( IfaceType, toIfaceType, 
 			  interactiveExtNameFun )
 import IfaceEnv		( lookupOrig, ifaceExportNames )
-import Module		( lookupModuleEnv )
+import Module		( lookupModuleEnv, moduleSetElts, mkModuleSet )
 import RnEnv		( lookupOccRn, dataTcOccs, lookupFixityRn )
-import Id		( isImplicitId, setIdType, globalIdDetails, mkExportedLocalId )
+import Id		( isImplicitId, setIdType, globalIdDetails )
 import MkId		( unsafeCoerceId )
 import DataCon		( dataConTyCon )
 import TyCon		( tyConName )
@@ -121,7 +121,7 @@ import SrcLoc		( interactiveSrcLoc, unLoc )
 import Kind		( Kind )
 import Var		( globaliseId )
 import Name		( nameOccName, nameModule )
-import OccName		( occNameUserString )
+import OccName		( occNameUserString, isTcOcc )
 import NameEnv		( delListFromNameEnv )
 import PrelNames	( iNTERACTIVE, ioTyConName, printName, itName, 
 			  bindIOName, thenIOName, returnIOName )
@@ -1228,6 +1228,12 @@ tcRnGetInfo hsc_env ictxt rdr_name
   = initTcPrintErrors hsc_env iNTERACTIVE $ 
     setInteractiveContext hsc_env ictxt $ do {
 
+	-- Load the interface for all unqualified types and classes
+	-- That way we will find all the instance declarations
+	-- (Packages have not orphan modules, and we assume that
+	--  in the home package all relevant modules are loaded.)
+    loadUnqualIfaces ictxt ;
+
     good_names <- lookup_rdr_name rdr_name ;
 
 	-- And lookup up the entities, avoiding duplicates, which arise
@@ -1301,6 +1307,21 @@ toIfaceDecl ext_nm thing
 			ClassOpId cls      -> AClass cls
 			other		   -> AnId id
     munge other_thing = other_thing
+
+loadUnqualIfaces :: InteractiveContext -> TcM ()
+-- Load the home module for everything that is in scope unqualified
+-- This is so that we can accurately report the instances for 
+-- something
+loadUnqualIfaces ictxt
+  = initIfaceTcRn $
+    mapM_ (loadSysInterface doc) (moduleSetElts (mkModuleSet unqual_mods))
+  where
+    unqual_mods = [ nameModule name
+		  | gre <- globalRdrEnvElts (ic_rn_gbl_env ictxt),
+		    let name = gre_name gre,
+		    isTcOcc (nameOccName name),  -- Types and classes only
+		    unQualOK gre ]		 -- In scope unqualified
+    doc = ptext SLIT("Need interface for module whose export(s) are in scope unqualified")
 #endif /* GHCI */
 \end{code}
 
-- 
1.7.10.4