From 344d961bc81a11d16cb7f37d213379b3c9783f17 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Thu, 28 Apr 2005 13:13:27 +0000
Subject: [PATCH] [project @ 2005-04-28 13:13:27 by simonpj] Instance for
 wired-in tycons wibble

---
 ghc/compiler/iface/LoadIface.lhs |   19 ++++++++++++++-----
 ghc/compiler/iface/TcIface.lhs   |   38 ++++++++++++++++++--------------------
 2 files changed, 32 insertions(+), 25 deletions(-)

diff --git a/ghc/compiler/iface/LoadIface.lhs b/ghc/compiler/iface/LoadIface.lhs
index 9415ac0..15217b8 100644
--- a/ghc/compiler/iface/LoadIface.lhs
+++ b/ghc/compiler/iface/LoadIface.lhs
@@ -5,10 +5,10 @@
 
 \begin{code}
 module LoadIface (
-	loadHomeInterface, loadInterface, loadDecls,
+	loadHomeInterface, loadInterface, loadWiredInHomeIface, 
 	loadSrcInterface, loadOrphanModules, 
 	findAndReadIface, readIface,	-- Used when reading the module's old interface
-	ifaceStats, discardDeclPrags,
+	loadDecls, ifaceStats, discardDeclPrags,
 	initExternalPackageState
    ) where
 
@@ -20,8 +20,7 @@ import Packages		( PackageState(..), PackageIdH(..), isHomePackage )
 import DynFlags		( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ),
 			  isOneShot )
 import IfaceSyn		( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..),
-			  IfaceConDecls(..), IfaceExpr(..), IfaceIdInfo(..), 
-			  IfaceType(..), IfaceExtName )
+			  IfaceConDecls(..), IfaceIdInfo(..) )
 import IfaceEnv		( newGlobalBinder )
 import HscTypes		( ModIface(..), TyThing, emptyModIface, EpsStats(..),
 			  addEpsInStats, ExternalPackageState(..),
@@ -41,7 +40,7 @@ import PrelRules	( builtinRules )
 import Rules		( extendRuleBaseList, mkRuleBase )
 import InstEnv		( emptyInstEnv, extendInstEnvList )
 import Name		( Name {-instance NamedThing-}, getOccName,
-			  nameModule, isInternalName )
+			  nameModule, isInternalName, isWiredInName )
 import NameEnv
 import MkId		( seqId )
 import Module		( Module, ModLocation(ml_hi_file), emptyModuleEnv, 
@@ -106,6 +105,16 @@ loadHomeInterface doc name
     initIfaceTcRn $ loadSysInterface doc (nameModule name)
 
 ---------------
+loadWiredInHomeIface :: Name -> IfM lcl ()
+-- A IfM function to load the home interface for a wired-in thing,
+-- so that we're sure that we see its instance declarations and rules
+loadWiredInHomeIface name
+  = ASSERT( isWiredInName name )
+    do { loadSysInterface doc (nameModule name); return () }
+  where
+    doc = ptext SLIT("Need home interface for wired-in thing") <+> ppr name
+
+---------------
 loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
 -- A wrapper for loadInterface that Throws an exception if it fails
 loadSysInterface doc mod_name
diff --git a/ghc/compiler/iface/TcIface.lhs b/ghc/compiler/iface/TcIface.lhs
index f7b9ca0..9da3b88 100644
--- a/ghc/compiler/iface/TcIface.lhs
+++ b/ghc/compiler/iface/TcIface.lhs
@@ -13,7 +13,8 @@ module TcIface (
 #include "HsVersions.h"
 
 import IfaceSyn
-import LoadIface	( loadInterface, loadHomeInterface, loadDecls, findAndReadIface )
+import LoadIface	( loadInterface, loadWiredInHomeIface,
+			  loadDecls, findAndReadIface )
 import IfaceEnv		( lookupIfaceTop, lookupIfaceExt, newGlobalBinder, 
 			  extendIfaceIdEnv, extendIfaceTyVarEnv, newIPName,
 			  tcIfaceTyVar, tcIfaceLclId, lookupIfaceTc, 
@@ -110,7 +111,8 @@ tcImportDecl :: Name -> TcM TyThing
 -- Entry point for *source-code* uses of importDecl
 tcImportDecl name 
   | Just thing <- wiredInNameTyThing_maybe name
-  = do	{ checkWiredInName name; return thing }
+  = do	{ initIfaceTcRn (loadWiredInHomeIface name) 
+	; return thing }
   | otherwise
   = do 	{ traceIf (text "tcLookupGlobal" <+> ppr name)
 	; mb_thing <- initIfaceTcRn (importDecl name)
@@ -119,30 +121,23 @@ tcImportDecl name
 	    Failed err      -> failWithTc err }
 
 checkWiredInTyCon :: TyCon -> TcM ()
--- Ensure its instances are loaded
--- It might not be a wired-in tycon (see the calls in TcUnify)
+-- Ensure that the home module of the TyCon (and hence its instances)
+-- are loaded. It might not be a wired-in tycon (see the calls in TcUnify),
+-- in which case this is a no-op.
 checkWiredInTyCon tc	
-  | not (isWiredInName tc_name) = return ()
-  | otherwise			= checkWiredInName tc_name
-  where
-    tc_name = tyConName tc
-
-checkWiredInName :: Name -> TcM ()
--- We "check" a wired-in name solely to check that its
--- interface file is loaded, so that we're sure that we see
--- its instance declarations and rules
-checkWiredInName name
-  = ASSERT( isWiredInName name )
-    do	{ mod <- getModule
-	; if nameIsLocalOrFrom mod name then
+  | not (isWiredInName tc_name) 
+  = return ()
+  | otherwise
+  = do	{ mod <- getModule
+	; if nameIsLocalOrFrom mod tc_name then
 		-- Don't look for (non-existent) Float.hi when
 		-- compiling Float.lhs, which mentions Float of course
 		return ()
 	  else	-- A bit yukky to call initIfaceTcRn here
-	  do { loadHomeInterface doc name; return () }
+		initIfaceTcRn (loadWiredInHomeIface tc_name) 
 	}
   where
-    doc = ptext SLIT("Need home interface for wired-in thing") <+> ppr name
+    tc_name = tyConName tc
 
 importDecl :: Name -> IfM lcl (MaybeErr Message TyThing)
 -- Get the TyThing for this Name from an interface file
@@ -834,7 +829,10 @@ tcPragExpr name expr
 tcIfaceGlobal :: Name -> IfL TyThing
 tcIfaceGlobal name
   | Just thing <- wiredInNameTyThing_maybe name
-  = return thing
+  = do { loadWiredInHomeIface name; return thing }
+	-- Even though we are in an interface file, we want to make
+	-- sure its instances are loaded (imagine f :: Double -> Double)
+	-- and its RULES are loaded too
   | otherwise
   = do	{ (eps,hpt) <- getEpsAndHpt
 	; case lookupType hpt (eps_PTE eps) name of {
-- 
1.7.10.4