[project @ 2000-10-31 08:08:38 by simonpj]

More tidying up; esp of isLocallyDefined

16 files changed, 231 insertions, 247 deletions

diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile
index 413f59e474..896a431e35 100644
--- a/ghc/compiler/Makefile
+++ b/ghc/compiler/Makefile
@@ -1,5 +1,5 @@
 # -----------------------------------------------------------------------------
-# $Id: Makefile,v 1.103 2000/10/30 11:18:14 sewardj Exp $
+# $Id: Makefile,v 1.104 2000/10/31 08:08:38 simonpj Exp $
 
 TOP = ..
 include $(TOP)/mk/boilerplate.mk
@@ -366,7 +366,9 @@ parser/Parser.hs : parser/Parser.y
 #-----------------------------------------------------------------------------
 # 		Linking
 
-SRC_LD_OPTS += -no-link-chk -ldl
+SRC_LD_OPTS += -no-link-chk 
+# REMOVED SLPJ
+# -ldl
 
 ifneq "$(GhcWithHscBuiltViaC)" "YES"
 ifeq "$(GhcReportCompiles)" "YES"
diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index a11b797ffa..eb66139f52 100644
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -21,7 +21,7 @@ module Name (
 	toRdrName, hashName,
 
 	isUserExportedName,
-	nameSrcLoc, isLocallyDefinedName, isDllName,
+	nameSrcLoc, nameIsLocallyDefined, isDllName, nameIsFrom, nameIsLocalOrFrom,
 
 	isSystemName, isLocalName, isGlobalName, isExternallyVisibleName,
 	isTyVarName,
@@ -36,7 +36,8 @@ module Name (
 
 	-- Class NamedThing and overloaded friends
 	NamedThing(..),
-	getSrcLoc, isLocallyDefined, getOccString, toRdrName
+	getSrcLoc, isLocallyDefined, getOccString, toRdrName,
+	isFrom, isLocalOrFrom
     ) where
 
 #include "HsVersions.h"
@@ -121,7 +122,9 @@ nameModule_maybe name				= Nothing
 \end{code}
 
 \begin{code}
-isLocallyDefinedName	:: Name -> Bool
+nameIsLocallyDefined	:: Name -> Bool
+nameIsFrom		:: Module -> Name -> Bool
+nameIsLocalOrFrom	:: Module -> Name -> Bool
 isUserExportedName	:: Name -> Bool
 isLocalName		:: Name -> Bool		-- Not globals
 isGlobalName		:: Name -> Bool
@@ -133,14 +136,23 @@ isGlobalName other	                = False
 
 isLocalName name = not (isGlobalName name)
 
-isLocallyDefinedName name = isLocalName name
+nameIsLocallyDefined name = isLocalName name
+
+nameIsLocalOrFrom from (Name {n_sort = Global mod}) = mod == from
+nameIsLocalOrFrom from other			    = True
+
+nameIsFrom from (Name {n_sort = Global mod}) = mod == from
+nameIsFrom from other			     = pprPanic "nameIsFrom" (ppr other)
 
 -- Global names are by definition those that are visible
 -- outside the module, *as seen by the linker*.  Externally visible
--- does not mean visible at the source level (that's isExported).
+-- does not mean visible at the source level (that's isUserExported).
 isExternallyVisibleName name = isGlobalName name
 
+-- Constructors, selectors and suchlike Globals, and are all exported
+-- Other Local things may or may not be exported
 isUserExportedName (Name { n_sort = Exported }) = True
+isUserExportedName (Name { n_sort = Global _ }) = True
 isUserExportedName other		        = False
 
 isSystemName (Name {n_sort = System}) = True
@@ -354,7 +366,7 @@ ifaceNameRdrName n | isLocallyDefined n = mkRdrUnqual (nameOccName n)
 isDllName :: Name -> Bool
 	-- Does this name refer to something in a different DLL?
 isDllName nm = not opt_Static &&
-	       not (isLocallyDefinedName nm) &&		-- isLocallyDefinedName test needed 'cos
+	       not (nameIsLocallyDefined nm) &&			-- isLocallyDefinedName test needed 'cos
 	       not (isModuleInThisPackage (nameModule nm))	-- nameModule won't work on local names
 
 
@@ -494,11 +506,15 @@ getSrcLoc	    :: NamedThing a => a -> SrcLoc
 isLocallyDefined    :: NamedThing a => a -> Bool
 getOccString	    :: NamedThing a => a -> String
 toRdrName	    :: NamedThing a => a -> RdrName
+isFrom		    :: NamedThing a => Module -> a -> Bool
+isLocalOrFrom	    :: NamedThing a => Module -> a -> Bool
 
 getSrcLoc	    = nameSrcLoc	   . getName
-isLocallyDefined    = isLocallyDefinedName . getName
+isLocallyDefined    = nameIsLocallyDefined . getName
 getOccString 	    = occNameString	   . getOccName
 toRdrName	    = ifaceNameRdrName	   . getName
+isFrom mod x	    = nameIsFrom mod (getName x)
+isLocalOrFrom mod x = nameIsLocalOrFrom mod ( getName x)
 \end{code}
 
 \begin{code}
diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index ab77b47b23..ccfddd5e51 100644
--- a/ghc/compiler/main/HscTypes.lhs
+++ b/ghc/compiler/main/HscTypes.lhs
@@ -10,7 +10,7 @@ module HscTypes (
 	ModDetails(..),	ModIface(..), 
 	HomeSymbolTable, PackageTypeEnv,
 	HomeIfaceTable, PackageIfaceTable, emptyIfaceTable,
-	lookupTable, lookupTableByModName,
+	lookupIface, lookupIfaceByModName,
 	emptyModIface,
 
 	IfaceDecls(..), 
@@ -47,8 +47,9 @@ module HscTypes (
 import RdrName		( RdrNameEnv, emptyRdrEnv )
 import Name		( Name, NameEnv, NamedThing,
 			  emptyNameEnv, extendNameEnv, 
-			  lookupNameEnv, emptyNameEnv, getName, nameModule,
-			  nameSrcLoc, nameEnvElts )
+			  lookupNameEnv, emptyNameEnv, nameEnvElts,
+			  isLocallyDefined, getName, nameModule,
+			  nameSrcLoc )
 import NameSet		( NameSet )
 import OccName		( OccName )
 import Module		( Module, ModuleName, ModuleEnv,
@@ -200,16 +201,19 @@ emptyIfaceTable = emptyUFM
 Simple lookups in the symbol table.
 
 \begin{code}
-lookupTable :: ModuleEnv a -> ModuleEnv a -> Name -> Maybe a
--- We often have two Symbol- or IfaceTables, and want to do a lookup
-lookupTable ht pt name
-  = lookupModuleEnv ht mod `seqMaybe` lookupModuleEnv pt mod
+lookupIface :: HomeIfaceTable -> PackageIfaceTable
+	    -> Module -> Name		-- The module is to use for locally-defined names
+	    -> Maybe ModIface
+-- We often have two IfaceTables, and want to do a lookup
+lookupIface hit pit this_mod name
+  | isLocallyDefined name = lookupModuleEnv hit this_mod
+  | otherwise		  = lookupModuleEnv hit mod `seqMaybe` lookupModuleEnv pit mod
   where
     mod = nameModule name
 
-lookupTableByModName :: ModuleEnv a -> ModuleEnv a -> ModuleName -> Maybe a
+lookupIfaceByModName :: ModuleEnv a -> ModuleEnv a -> ModuleName -> Maybe a
 -- We often have two Symbol- or IfaceTables, and want to do a lookup
-lookupTableByModName ht pt mod
+lookupIfaceByModName ht pt mod
   = lookupModuleEnvByName ht mod `seqMaybe` lookupModuleEnvByName pt mod
 \end{code}
 
@@ -260,7 +264,8 @@ extendTypeEnvList env things
 \begin{code}
 lookupType :: HomeSymbolTable -> PackageTypeEnv -> Name -> Maybe TyThing
 lookupType hst pte name
-  = case lookupModuleEnv hst (nameModule name) of
+  = ASSERT2( not (isLocallyDefined name), ppr name )
+    case lookupModuleEnv hst (nameModule name) of
 	Just details -> lookupNameEnv (md_types details) name
 	Nothing	     -> lookupNameEnv pte name
 \end{code}
diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index c837f4cbbb..8eec30d614 100644
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -128,9 +128,6 @@ completeIface :: Maybe ModIface		-- The old interface, if we have it
 	-- NB: 'Nothing' means that even the usages havn't changed, so there's no
 	--     need to write a new interface file.  But even if the usages have
 	--     changed, the module version may not have.
-	--
-	-- The IO in the type is solely for debug output
-	-- In particular, dumping a record of what has changed
 completeIface maybe_old_iface new_iface mod_details 
   = addVersionInfo maybe_old_iface (new_iface { mi_decls = new_decls })
   where
@@ -628,14 +625,13 @@ pprIface iface
 	, vcat (map pprExport (mi_exports iface))
 	, vcat (map pprUsage (mi_usages iface))
 
-	, pprIfaceDecls (vers_decls version_info) 
-			(mi_fixities iface)
-			(mi_decls iface)
-
+	, pprFixities (mi_fixities iface) (dcl_tycl decls)
+	, pprIfaceDecls (vers_decls version_info) decls
 	, pprDeprecs (mi_deprecs iface)
 	]
   where
     version_info = mi_version iface
+    decls	 = mi_decls iface
     exp_vers     = vers_exports version_info
     rule_vers	 = vers_rules version_info
 
@@ -696,27 +692,27 @@ pprUsage (m, has_orphans, is_boot, whats_imported)
 \end{code}
 
 \begin{code}
-pprIfaceDecls version_map fixity_map decls
+pprIfaceDecls version_map decls
   = vcat [ vcat [ppr i <+> semi | i <- dcl_insts decls]
 	 , vcat (map ppr_decl (dcl_tycl decls))
 	 , pprRules (dcl_rules decls)
 	 ]
   where
-    ppr_decl d  = (ppr_vers d <+> ppr d <> semi) $$ ppr_fixes d
+    ppr_decl d  = ppr_vers d <+> ppr d <> semi
 
 	-- Print the version for the decl
     ppr_vers d = case lookupNameEnv version_map (tyClDeclName d) of
 		   Nothing -> empty
 		   Just v  -> int v
-
-	-- Print fixities relevant to the decl
-    ppr_fixes d = vcat [ ppr fix <+> ppr n <> semi
-		       | (n,_) <- tyClDeclNames d, 
-			 Just fix <- [lookupNameEnv fixity_map n]
-		       ]
 \end{code}
 
 \begin{code}
+pprFixities fixity_map decls
+  = hsep [ ppr fix <+> ppr n 
+	 | d <- decls, 
+	   (n,_) <- tyClDeclNames d, 
+	   Just fix <- [lookupNameEnv fixity_map n]] <> semi
+
 pprRules []    = empty
 pprRules rules = hsep [ptext SLIT("{-## __R"), vcat (map ppr rules), ptext SLIT("##-}")]
 
diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index 88beb68220..c3a1e3209a 100644
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -36,7 +36,8 @@ import Module           ( Module, ModuleName, WhereFrom(..),
 			  moduleNameUserString, moduleName,
 			  mkModuleInThisPackage, mkModuleName, moduleEnvElts
 			)
-import Name		( Name, isLocallyDefined, NamedThing(..), getSrcLoc,
+import Name		( Name, NamedThing(..), getSrcLoc,
+			  nameIsLocalOrFrom,
 			  nameOccName, nameModule,
 			  mkNameEnv, nameEnvElts, extendNameEnv
 			)
@@ -65,7 +66,7 @@ import HscTypes		( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
 			  VersionInfo(..), ImportVersion, IfaceDecls(..),
 			  GlobalRdrEnv, AvailEnv, GenAvailInfo(..), AvailInfo, 
 			  Provenance(..), ImportReason(..), initialVersionInfo,
-			  Deprecations(..), lookupDeprec, lookupTable
+			  Deprecations(..), lookupDeprec, lookupIface
 			 )
 import List		( partition, nub )
 \end{code}
@@ -159,11 +160,9 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
     else
 
 	-- GENERATE THE VERSION/USAGE INFO
-    mkImportInfo mod_name imports 	`thenRn` \ my_usages ->
+    mkImportInfo mod_name imports 			`thenRn` \ my_usages ->
 
-	-- RETURN THE RENAMED MODULE
-    getNameSupplyRn			`thenRn` \ name_supply ->
-    getIfacesRn 			`thenRn` \ ifaces ->
+	-- BUILD THE MODULE INTERFACE
     let
 	-- We record fixities even for things that aren't exported,
 	-- so that we can change into the context of this moodule easily
@@ -171,23 +170,23 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
 			     | FixitySig name fixity loc <- nameEnvElts local_fixity_env
 			     ]
 
-
 	-- Sort the exports to make them easier to compare for versions
 	my_exports = groupAvails this_module export_avails
 	
+	final_decls = rn_local_decls ++ rn_imp_decls
+	is_orphan   = any (isOrphanDecl this_module) rn_local_decls
+
 	mod_iface = ModIface {	mi_module   = this_module,
 				mi_version  = initialVersionInfo,
+				mi_usages = my_usages,
 				mi_boot	    = False,
-				mi_orphan   = any isOrphanDecl rn_local_decls,
+				mi_orphan   = is_orphan,
 				mi_exports  = my_exports,
 				mi_globals  = gbl_env,
-				mi_usages   = my_usages,
 				mi_fixities = fixities,
 				mi_deprecs  = my_deprecs,
 				mi_decls    = panic "mi_decls"
 		    }
-
-	final_decls = rn_local_decls ++ rn_imp_decls
     in
 
 	-- REPORT UNUSED NAMES, AND DEBUG DUMP 
@@ -253,20 +252,21 @@ implicitFVs mod_name decls
 \end{code}
 
 \begin{code}
-isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
-  = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames (removeContext inst_ty)))
+isOrphanDecl this_mod (InstD (InstDecl inst_ty _ _ _ _))
+  = not (foldNameSet ((||) . nameIsLocalOrFrom this_mod) False 
+		     (extractHsTyNames (removeContext inst_ty)))
 	-- The 'removeContext' is because of
 	--	instance Foo a => Baz T where ...
 	-- The decl is an orphan if Baz and T are both not locally defined,
 	--	even if Foo *is* locally defined
 
-isOrphanDecl (RuleD (HsRule _ _ _ lhs _ _))
+isOrphanDecl this_mod (RuleD (HsRule _ _ _ lhs _ _))
   = check lhs
   where
 	-- At the moment we just check for common LHS forms
 	-- Expand as necessary.  Getting it wrong just means
 	-- more orphans than necessary
-    check (HsVar v)   	  = not (isLocallyDefined v)
+    check (HsVar v)   	  = not (nameIsLocalOrFrom this_mod v)
     check (HsApp f a) 	  = check f && check a
     check (HsLit _)   	  = False
     check (HsOverLit _)	  = False
@@ -278,7 +278,7 @@ isOrphanDecl (RuleD (HsRule _ _ _ lhs _ _))
 
     check other	      	  = True 	-- Safe fall through
 
-isOrphanDecl other = False
+isOrphanDecl _ _  = False
 \end{code}
 
 
@@ -540,12 +540,14 @@ reportUnusedNames my_mod_iface imports avail_env
   = warnUnusedModules unused_imp_mods				`thenRn_`
     warnUnusedLocalBinds bad_locals				`thenRn_`
     warnUnusedImports bad_imp_names				`thenRn_`
-    printMinimalImports my_mod_iface minimal_imports		`thenRn_`
-    warnDeprecations my_mod_iface really_used_names		`thenRn_`
+    printMinimalImports this_mod minimal_imports		`thenRn_`
+    warnDeprecations this_mod my_deprecs really_used_names	`thenRn_`
     returnRn ()
 
   where
+    this_mod   = mi_module my_mod_iface
     gbl_env    = mi_globals my_mod_iface
+    my_deprecs = mi_deprecs my_mod_iface
     
     -- Now, a use of C implies a use of T,
     -- if C was brought into scope by T(..) or T(C)
@@ -638,7 +640,7 @@ reportUnusedNames my_mod_iface imports avail_env
     module_unused mod = moduleName mod `elem` unused_imp_mods
 
 
-warnDeprecations my_mod_iface used_names
+warnDeprecations this_mod my_deprecs used_names
   = doptRn Opt_WarnDeprecations				`thenRn` \ warn_drs ->
     if not warn_drs then returnRn () else
 
@@ -653,15 +655,16 @@ warnDeprecations my_mod_iface used_names
     mapRn_ warnDeprec deprecs
 
   where
-    my_deprecs = mi_deprecs my_mod_iface
-    lookup_deprec hit pit n 
-	| isLocallyDefined n = lookupDeprec my_deprecs n
-	| otherwise	     = case lookupTable hit pit n of
-				 Just iface -> lookupDeprec (mi_deprecs iface) n
-				 Nothing    -> pprPanic "warnDeprecations:" (ppr n)
+    lookup_deprec hit pit n
+	| nameIsLocalOrFrom this_mod n
+	= lookupDeprec my_deprecs n 
+	| otherwise
+	= case lookupIface hit pit this_mod n of
+		Just iface -> lookupDeprec (mi_deprecs iface) n
+		Nothing    -> pprPanic "warnDeprecations:" (ppr n)
 
 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
-printMinimalImports my_mod_iface imps
+printMinimalImports this_mod imps
   = doptRn Opt_D_dump_minimal_imports		`thenRn` \ dump_minimal ->
     if not dump_minimal then returnRn () else
 
@@ -671,8 +674,7 @@ printMinimalImports my_mod_iface imps
 	})					`thenRn_`
     returnRn ()
   where
-    filename = moduleNameUserString (moduleName (mi_module my_mod_iface)) 
-	       ++ ".imports"
+    filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
     ppr_mod_ie (mod_name, ies) 
 	| mod_name == pRELUDE_Name 
 	= empty
@@ -706,7 +708,7 @@ rnDump  :: [RenamedHsDecl] 	-- Renamed imported decls
 rnDump imp_decls local_decls
   = doptRn Opt_D_dump_rn_trace 	`thenRn` \ dump_rn_trace ->
     doptRn Opt_D_dump_rn_stats 	`thenRn` \ dump_rn_stats ->
-    doptRn Opt_D_dump_rn 		`thenRn` \ dump_rn ->
+    doptRn Opt_D_dump_rn 	`thenRn` \ dump_rn ->
     getIfacesRn			`thenRn` \ ifaces ->
 
     ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
@@ -735,12 +737,11 @@ getRnStats imported_decls ifaces
     n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
 	-- This is really only right for a one-shot compile
     
-    decls_read     = [decl | (avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
+    decls_read     = [decl | (avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces)
     			-- Data, newtype, and class decls are in the decls_fm
     			-- under multiple names; the tycon/class, and each
     			-- constructor/class op too.
     			-- The 'True' selects just the 'main' decl
-    			 not (isLocallyDefined (availName avail))
     		     ]
     
     (cd_rd, dd_rd, nd_rd, sd_rd, vd_rd)        = countTyClDecls decls_read
diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 023e10c523..97f505e673 100644
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -663,7 +663,7 @@ groupAvails this_mod avails
     ]
   where
     groupFM :: FiniteMap FastString Avails
-	-- Deliberatey use the FastString so we
+	-- Deliberately use the FastString so we
 	-- get a canonical ordering
     groupFM = foldl add emptyFM avails
 
diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs
index 2fa3bdd22c..ca381a37ba 100644
--- a/ghc/compiler/rename/RnHiFiles.lhs
+++ b/ghc/compiler/rename/RnHiFiles.lhs
@@ -21,7 +21,7 @@ import CmdLineOpts	( DynFlag(..), opt_IgnoreIfacePragmas )
 import HscTypes		( ModuleLocation(..),
 			  ModIface(..), emptyModIface,
 			  VersionInfo(..),
-			  lookupTableByModName, 
+			  lookupIfaceByModName, 
 			  ImportVersion, WhetherHasOrphans, IsBootInterface,
 			  DeclsMap, GatedDecl, IfaceInsts, IfaceRules,
 			  AvailInfo, GenAvailInfo(..), Avails, Deprecations(..)
@@ -40,7 +40,7 @@ import RnMonad
 import ParseIface	( parseIface, IfaceStuff(..) )
 
 import Name		( Name {-instance NamedThing-}, nameOccName,
-			  nameModule, isLocallyDefined, 
+			  nameModule, isLocalName, nameIsLocalOrFrom,
 			  NamedThing(..),
 			  mkNameEnv, extendNameEnv
 			 )
@@ -76,7 +76,8 @@ import Monad		( when )
 \begin{code}
 loadHomeInterface :: SDoc -> Name -> RnM d ModIface
 loadHomeInterface doc_str name
-  = loadInterface doc_str (moduleName (nameModule name)) ImportBySystem
+  = ASSERT2( not (isLocalName name), ppr name <+> parens doc_str )
+    loadInterface doc_str (moduleName (nameModule name)) ImportBySystem
 
 loadOrphanModules :: [ModuleName] -> RnM d ()
 loadOrphanModules mods
@@ -110,7 +111,7 @@ tryLoadInterface doc_str mod_name from
    getIfacesRn 			`thenRn` \ ifaces@(Ifaces { iPIT = pit }) ->
 	
 	-- CHECK WHETHER WE HAVE IT ALREADY
-   case lookupTableByModName hit pit mod_name of {
+   case lookupIfaceByModName hit pit mod_name of {
 	Just iface  -> returnRn (iface, Nothing) ;	-- Already loaded
 	Nothing	    -> 
 
@@ -191,7 +192,7 @@ tryLoadInterface doc_str mod_name from
 			ImportByUser -> addModDeps mod is_loaded (pi_usages iface) mod_map
 			other        -> mod_map
 	mod_map2 = delFromFM mod_map1 mod_name
-	is_loaded m = maybeToBool (lookupTableByModName hit pit m)
+	is_loaded m = maybeToBool (lookupIfaceByModName hit pit m)
 
 	-- Now add info about this module to the PIT
 	has_orphans = pi_orphan iface
@@ -553,16 +554,32 @@ readIface tr file_path
 %*							*
 %*********************************************************
 
-This has to be in RnIfaces (or RnHiFiles) because it calls loadHomeInterface
+@lookupFixityRn@ has to be in RnIfaces (or RnHiFiles) because 
+it calls @loadHomeInterface@.
+
+lookupFixity is a bit strange.  
+
+* Nested local fixity decls are put in the local fixity env, which we
+  find with getFixtyEnv
+
+* Imported fixities are found in the HIT or PIT
+
+* Top-level fixity decls in this module may be for Names that are
+    either  Global	   (constructors, class operations)
+    or 	    Local/Exported (everything else)
+  (See notes with RnNames.getLocalDeclBinders for why we have this split.)
+  We put them all in the local fixity environment
 
 \begin{code}
 lookupFixityRn :: Name -> RnMS Fixity
 lookupFixityRn name
-  | isLocallyDefined name
-  = getFixityEnv			`thenRn` \ local_fix_env ->
-    returnRn (lookupLocalFixity local_fix_env name)
+  = getModuleRn				`thenRn` \ this_mod ->
+    if nameIsLocalOrFrom this_mod name
+    then	-- It's defined in this module
+	getFixityEnv			`thenRn` \ local_fix_env ->
+	returnRn (lookupLocalFixity local_fix_env name)
 
-  | otherwise	-- Imported
+    else	-- It's imported
       -- For imported names, we have to get their fixities by doing a loadHomeInterface,
       -- and consulting the Ifaces that comes back from that, because the interface
       -- file for the Name might not have been loaded yet.  Why not?  Suppose you import module A,
@@ -570,11 +587,10 @@ lookupFixityRn name
       -- right away (after all, it's possible that nothing from B will be used).
       -- When we come across a use of 'f', we need to know its fixity, and it's then,
       -- and only then, that we load B.hi.  That is what's happening here.
-  = getHomeIfaceTableRn 		`thenRn` \ hit ->
-    loadHomeInterface doc name		`thenRn` \ iface ->
-    returnRn (lookupNameEnv (mi_fixities iface) name `orElse` defaultFixity)
+  	loadHomeInterface doc name		`thenRn` \ iface ->
+	returnRn (lookupNameEnv (mi_fixities iface) name `orElse` defaultFixity)
   where
-    doc = ptext SLIT("Checking fixity for") <+> ppr name
+    doc      = ptext SLIT("Checking fixity for") <+> ppr name
 \end{code}
 
 
diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index 81c9ab9980..8d371ceac9 100644
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -36,7 +36,7 @@ import Id		( idType )
 import Type		( namesOfType )
 import TyCon		( isSynTyCon, getSynTyConDefn )
 import Name		( Name {-instance NamedThing-}, nameOccName,
-			  nameModule, isLocallyDefined, nameUnique,
+			  nameModule, isLocalName, nameUnique,
 			  NamedThing(..),
 			  elemNameEnv
 			 )
@@ -458,15 +458,14 @@ getSlurped
 
 recordSlurp ifaces@(Ifaces { iSlurp = slurped_names, iVSlurp = (imp_mods, imp_names) })
 	    avail
-  = let
-	new_slurped_names = addAvailToNameSet slurped_names avail
-	new_vslurp | isModuleInThisPackage mod = (imp_mods, addOneToNameSet imp_names name)
-		   | otherwise		       = (extendModuleSet imp_mods mod, imp_names)
-		   where
-		     mod = nameModule name
-		     name = availName avail
-    in
+  = ASSERT2( not (isLocalName (availName avail)), pprAvail avail )
     ifaces { iSlurp  = new_slurped_names, iVSlurp = new_vslurp }
+  where
+    main_name = availName avail
+    mod	      = nameModule main_name
+    new_slurped_names = addAvailToNameSet slurped_names avail
+    new_vslurp | isModuleInThisPackage mod = (imp_mods, addOneToNameSet imp_names main_name)
+    	       | otherwise		   = (extendModuleSet imp_mods mod, imp_names)
 
 recordLocalSlurps local_avails
   = getIfacesRn 	`thenRn` \ ifaces ->
@@ -647,7 +646,7 @@ data ImportDeclResult
 
 importDecl name
   = 	-- Check if it was loaded before beginning this module
-    if isLocallyDefined name then
+    if isLocalName name then
 	returnRn AlreadySlurped
     else
     checkAlreadyAvailable name		`thenRn` \ done ->
@@ -661,13 +660,6 @@ importDecl name
 	returnRn AlreadySlurped	
     else 
 
-	-- Don't slurp in decls from this module's own interface file
-	-- (Indeed, this shouldn't happen.)
-    if isLocallyDefined name then
-	addWarnRn (importDeclWarn name) `thenRn_`
-	returnRn AlreadySlurped
-    else
-
 	-- When we find a wired-in name we must load its home
 	-- module so that we find any instance decls lurking therein
     if name `elemNameEnv` wiredInThingEnv then
@@ -798,9 +790,8 @@ recompileRequired iface_path source_unchanged iface
 	returnRn outOfDate
     else
 
-	-- CHECK WHETHER WE HAVE AN OLD IFACE
 	-- Source code unchanged and no errors yet... carry on 
-	checkList [checkModUsage u | u <- mi_usages iface]
+    checkList [checkModUsage u | u <- mi_usages iface]
 
 checkList :: [RnMG RecompileRequired] -> RnMG RecompileRequired
 checkList []		 = returnRn upToDate
@@ -915,12 +906,4 @@ getDeclErr name
   = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
 	  ptext SLIT("from module") <+> quotes (ppr (nameModule name))
 	 ]
-
-importDeclWarn name
-  = sep [ptext SLIT(
-    "Compiler tried to import decl from interface file with same name as module."), 
-	 ptext SLIT(
-    "(possible cause: module name clashes with interface file already in scope.)")
-	] $$
-    hsep [ptext SLIT("name:"), quotes (ppr name)]
 \end{code}
diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 74101b781c..12f40893c2 100644
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -53,7 +53,7 @@ import RdrName		( RdrName, dummyRdrVarName, rdrNameModule, rdrNameOcc,
 			  addListToRdrEnv, rdrEnvToList, rdrEnvElts
 			)
 import Name		( Name, OccName, NamedThing(..), getSrcLoc,
-			  isLocallyDefinedName, nameOccName,
+			  nameOccName,
 			  decode, mkLocalName, mkKnownKeyGlobal,
 			  NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, 
 			  extendNameEnvList
@@ -68,7 +68,7 @@ import Bag		( Bag, emptyBag, isEmptyBag, snocBag )
 import UniqSupply
 import Outputable
 import PrelNames	( mkUnboundName )
-import Maybes		( maybeToBool, seqMaybe )
+import Maybes		( maybeToBool )
 import ErrUtils		( printErrorsAndWarnings )
 
 infixr 9 `thenRn`, `thenRn_`
@@ -145,7 +145,7 @@ data RnDown
 data SDown = SDown {
 		  rn_mode :: RnMode,
 
-		  rn_genv :: GlobalRdrEnv,    	-- Global envt
+		  rn_genv :: GlobalRdrEnv,	-- Top level environment
 
 		  rn_lenv :: LocalRdrEnv,	-- Local name envt
 			--   Does *not* include global name envt; may shadow it
@@ -155,9 +155,10 @@ data SDown = SDown {
 			-- We still need the unsullied global name env so that
 			--   we can look up record field names
 
-		  rn_fixenv :: LocalFixityEnv	-- Local fixities
+		  rn_fixenv :: LocalFixityEnv	-- Local fixities (for non-top-level
+						-- declarations)
 			-- The global fixities are held in the
-			-- rn_ifaces field.  Why?  See the comments
+			-- HIT or PIT.  Why?  See the comments
 			-- with RnIfaces.lookupLocalFixity
 		}
 
@@ -360,9 +361,12 @@ initRn dflags hit hst pcs mod do_rn
 
 is_done :: HomeSymbolTable -> PackageTypeEnv -> Name -> Bool
 -- Returns True iff the name is in either symbol table
+-- The name is a Global, so it has a Module
 is_done hst pte n = maybeToBool (lookupType hst pte n)
 
 initRnMS rn_env fixity_env mode thing_inside rn_down g_down
+	-- The fixity_env appears in both the rn_fixenv field
+	-- and in the HIT.  See comments with RnHiFiles.lookupFixityRn
   = let
 	s_down = SDown { rn_genv = rn_env, rn_lenv = emptyRdrEnv, 
 			 rn_fixenv = fixity_env, rn_mode = mode }
@@ -373,7 +377,6 @@ initIfaceRnMS :: Module -> RnMS r -> RnM d r
 initIfaceRnMS mod thing_inside 
   = initRnMS emptyRdrEnv emptyNameEnv InterfaceMode $
     setModuleRn mod thing_inside
-
 \end{code}
 
 @renameSourceCode@ is used to rename stuff ``out-of-line'';
@@ -588,6 +591,7 @@ getHomeIfaceTableRn :: RnM d HomeIfaceTable
 getHomeIfaceTableRn down l_down = return (rn_hit down)
 
 checkAlreadyAvailable :: Name -> RnM d Bool
+	-- Name is a Global name
 checkAlreadyAvailable name down l_down = return (rn_done down name)
 \end{code}
 
diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index 693c6000fb..09979d448f 100644
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -109,7 +109,7 @@ rnDecl (TyClD tycl_decl)
 rnDecl (InstD inst)
   = rnInstDecl inst		`thenRn` \ new_inst ->
     rnInstBinds inst new_inst	`thenRn` \ (new_inst', fvs) ->
-    returnRn (InstD new_inst, fvs `plusFV` instDeclFVs new_inst')
+    returnRn (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
 
 rnDecl (RuleD rule)
   | isIfaceRuleDecl rule
diff --git a/ghc/compiler/typecheck/TcClassDcl.lhs b/ghc/compiler/typecheck/TcClassDcl.lhs
index 3154f84f72..3af7420083 100644
--- a/ghc/compiler/typecheck/TcClassDcl.lhs
+++ b/ghc/compiler/typecheck/TcClassDcl.lhs
@@ -42,7 +42,8 @@ import Class		( classTyVars, classBigSig, classSelIds, classTyCon, classTvsFds,
 import MkId		( mkDictSelId, mkDataConId, mkDataConWrapId, mkDefaultMethodId )
 import DataCon		( mkDataCon, notMarkedStrict )
 import Id		( Id, idType, idName )
-import Name		( Name, isLocallyDefined, NamedThing(..),
+import Module		( Module )
+import Name		( Name, NamedThing(..), isFrom,
 			  NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, 
 			  plusNameEnv, nameEnvElts )
 import NameSet		( emptyNameSet )
@@ -296,8 +297,8 @@ tcClassSig rec_env clas clas_tyvars fds dm_info
 and superclass dictionary.
 
 \begin{code}
-mkImplicitClassBinds :: [Class] -> NF_TcM ([Id], TcMonoBinds)
-mkImplicitClassBinds classes
+mkImplicitClassBinds :: Module -> [Class] -> NF_TcM ([Id], TcMonoBinds)
+mkImplicitClassBinds this_mod classes
   = returnNF_Tc (concat cls_ids_s, andMonoBindList binds_s)
 	-- The selector binds are already in the selector Id's unfoldings
 	-- We don't return the data constructor etc from the class,
@@ -308,8 +309,8 @@ mkImplicitClassBinds classes
     mk_implicit clas = (sel_ids, binds)
 		     where
 			sel_ids = classSelIds clas
-			binds | isLocallyDefined clas = idsToMonoBinds sel_ids
-			      | otherwise	      = EmptyMonoBinds
+			binds | isFrom this_mod clas = idsToMonoBinds sel_ids
+			      | otherwise 	     = EmptyMonoBinds
 \end{code}
 
 
@@ -379,14 +380,14 @@ The function @tcClassDecls2@ just arranges to apply @tcClassDecl2@ to
 each local class decl.
 
 \begin{code}
-tcClassDecls2 :: [RenamedHsDecl] -> NF_TcM (LIE, TcMonoBinds)
+tcClassDecls2 :: Module -> [RenamedHsDecl] -> NF_TcM (LIE, TcMonoBinds)
 
-tcClassDecls2 decls
+tcClassDecls2 this_mod decls
   = foldr combine
 	  (returnNF_Tc (emptyLIE, EmptyMonoBinds))
 	  [tcClassDecl2 cls_decl | TyClD cls_decl <- decls, 
 				   isClassDecl cls_decl,
-				   isLocallyDefined (tyClDeclName cls_decl)]
+				   isFrom this_mod (tyClDeclName cls_decl)]
   where
     combine tc1 tc2 = tc1 `thenNF_Tc` \ (lie1, binds1) ->
 		      tc2 `thenNF_Tc` \ (lie2, binds2) ->
diff --git a/ghc/compiler/typecheck/TcDeriv.lhs b/ghc/compiler/typecheck/TcDeriv.lhs
index a654b7f8bf..08d28dc95c 100644
--- a/ghc/compiler/typecheck/TcDeriv.lhs
+++ b/ghc/compiler/typecheck/TcDeriv.lhs
@@ -31,21 +31,18 @@ import BasicTypes	( Fixity )
 import Class		( classKey, Class )
 import ErrUtils		( dumpIfSet_dyn, Message )
 import MkId		( mkDictFunId )
-import Id		( idType )
 import DataCon		( dataConArgTys, isNullaryDataCon, isExistentialDataCon )
 import PrelInfo		( needsDataDeclCtxtClassKeys )
 import Maybes		( maybeToBool, catMaybes )
 import Module		( Module )
-import Name		( Name, isLocallyDefined, getSrcLoc )
+import Name		( Name, isFrom, getSrcLoc )
 import RdrName		( RdrName )
 
 import TyCon		( tyConTyVars, tyConDataCons, tyConDerivings,
 			  tyConTheta, maybeTyConSingleCon, isDataTyCon,
 			  isEnumerationTyCon, TyCon
 			)
-import Type		( TauType, PredType(..), mkTyVarTys, mkTyConApp,
-			  splitDFunTy, isUnboxedType
-			)
+import Type		( TauType, PredType(..), mkTyVarTys, mkTyConApp, isUnboxedType )
 import Var		( TyVar )
 import PrelNames
 import Util		( zipWithEqual, sortLt, thenCmp )
@@ -184,16 +181,16 @@ tcDeriving  :: PersistentRenamerState
 	    -> Module			-- name of module under scrutiny
 	    -> InstEnv			-- What we already know about instances
 	    -> (Name -> Maybe Fixity)	-- used in deriving Show and Read
-	    -> [TyCon]			-- "local_tycons" ???
+	    -> [TyCon]			-- All type constructors
 	    -> TcM ([InstInfo],		-- The generated "instance decls".
 		    RenamedHsBinds)	-- Extra generated bindings
 
-tcDeriving prs mod inst_env_in get_fixity local_tycons
+tcDeriving prs mod inst_env_in get_fixity tycons
   = recoverTc (returnTc ([], EmptyBinds)) $
 
   	-- Fish the "deriving"-related information out of the TcEnv
 	-- and make the necessary "equations".
-    makeDerivEqns mod local_tycons	    	`thenTc` \ eqns ->
+    makeDerivEqns mod tycons	    	`thenTc` \ eqns ->
     if null eqns then
 	returnTc ([], EmptyBinds)
     else
@@ -230,7 +227,7 @@ tcDeriving prs mod inst_env_in get_fixity local_tycons
 			returnRn (rn_method_binds_s, rn_extra_binds)
 		  )
 
-	new_inst_infos = map gen_inst_info (new_dfuns `zip` rn_method_binds_s)
+	new_inst_infos = zipWith gen_inst_info new_dfuns rn_method_binds_s
     in
 
     ioToTc (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances" 
@@ -244,16 +241,10 @@ tcDeriving prs mod inst_env_in get_fixity local_tycons
       where
 
 	-- Make a Real dfun instead of the dummy one we have so far
-    gen_inst_info :: (DFunId, RenamedMonoBinds) -> InstInfo
-    gen_inst_info (dfun, binds)
-      = InstInfo { iLocal = True,
-		   iClass = clas, iTyVars = tyvars, 
-		   iTys = tys, iTheta = theta, 
-		   iDFunId = dfun, 
-		   iBinds = binds,
-		   iLoc = getSrcLoc dfun, iPrags = [] }
-        where
-	 (tyvars, theta, clas, tys) = splitDFunTy (idType dfun)
+    gen_inst_info :: DFunId -> RenamedMonoBinds -> InstInfo
+    gen_inst_info dfun binds
+      = InstInfo { iLocal = True,  iDFunId = dfun, 
+		   iBinds = binds, iPrags = [] }
 
     rn_meths meths = rnMethodBinds [] meths `thenRn` \ (meths', _) -> returnRn meths'
 	-- Ignore the free vars returned
@@ -284,12 +275,12 @@ all those.
 \begin{code}
 makeDerivEqns :: Module -> [TyCon] -> TcM [DerivEqn]
 
-makeDerivEqns this_mod local_tycons
+makeDerivEqns this_mod tycons
   = let
-	think_about_deriving = need_deriving local_tycons
+	think_about_deriving = need_deriving tycons
 	(derive_these, _)    = removeDups cmp_deriv think_about_deriving
     in
-    if null local_tycons then
+    if null think_about_deriving then
 	returnTc []	-- Bale out now
     else
     mapTc mk_eqn derive_these `thenTc`	\ maybe_eqns ->
@@ -300,9 +291,9 @@ makeDerivEqns this_mod local_tycons
 	-- find the tycons that have `deriving' clauses;
 
     need_deriving tycons_to_consider
-      = foldr (\ tycon acc -> [(clas,tycon) | clas <- tyConDerivings tycon] ++ acc)
-	      []
-	      tycons_to_consider
+      = [ (clas,tycon) | tycon <- tycons_to_consider,
+			 isFrom this_mod tycon,
+			 clas <- tyConDerivings tycon ]
 
     ------------------------------------------------------------------
     cmp_deriv :: (Class, TyCon) -> (Class, TyCon) -> Ordering
@@ -525,7 +516,6 @@ the renamer.  What a great hack!
 --  names.)
 gen_bind :: (Name -> Maybe Fixity) -> DFunId -> RdrNameMonoBinds
 gen_bind get_fixity dfun
-  | not (isLocallyDefined tycon) = EmptyMonoBinds
   | clas `hasKey` showClassKey   = gen_Show_binds get_fixity tycon
   | clas `hasKey` readClassKey   = gen_Read_binds get_fixity tycon
   | otherwise
diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs
index 88d0159552..3dfdb2edbd 100644
--- a/ghc/compiler/typecheck/TcEnv.lhs
+++ b/ghc/compiler/typecheck/TcEnv.lhs
@@ -11,7 +11,7 @@ module TcEnv(
 	-- Instance environment, and InstInfo type
 	tcGetInstEnv, tcSetInstEnv, 
 	InstInfo(..), pprInstInfo,
-	simpleInstInfoTy, simpleInstInfoTyCon, isLocalInst,
+	simpleInstInfoTy, simpleInstInfoTyCon, 
 
 	-- Global environment
 	tcExtendGlobalEnv, tcExtendGlobalValEnv, 
@@ -49,8 +49,8 @@ import IdInfo		( vanillaIdInfo )
 import MkId	 	( mkSpecPragmaId )
 import Var		( TyVar, Id, idType, lazySetIdInfo, idInfo )
 import VarSet
-import Type		( Type, ThetaType,
-			  tyVarsOfTypes,
+import Type		( Type,
+			  tyVarsOfTypes, splitDFunTy,
 			  splitForAllTys, splitRhoTy,
 			  getDFunTyKey, splitTyConApp_maybe
 			)
@@ -60,7 +60,7 @@ import Class		( Class, ClassOpItem, ClassContext )
 import Subst		( substTy )
 import Name		( Name, OccName, NamedThing(..), 
 			  nameOccName, nameModule, getSrcLoc, mkGlobalName,
-			  isLocallyDefined, nameModule_maybe,
+			  isLocalName, nameModule_maybe,
 			  NameEnv, lookupNameEnv, nameEnvElts, 
 			  extendNameEnvList, emptyNameEnv
 			)
@@ -151,7 +151,8 @@ initTcEnv hst pte
 		      	 tcTyVars = gtv_var
 	 })}
   where
-    lookup name = lookupType hst pte name
+    lookup name | isLocalName name = Nothing
+		| otherwise	   = lookupType hst pte name
 
 
 tcEnvClasses env = [cl | AClass cl <- nameEnvElts (tcGEnv env)]
@@ -508,16 +509,9 @@ The InstInfo type summarises the information in an instance declaration
 \begin{code}
 data InstInfo
   = InstInfo {
-      iClass :: Class,	        -- Class, k
-      iTyVars :: [TyVar],	-- Type variables, tvs
-      iTys    :: [Type],	-- The types at which the class is being instantiated
-      iTheta  :: ThetaType,	-- inst_decl_theta: the original context, c, from the
-				--   instance declaration.  It constrains (some of)
-				--   the TyVars above
-      iLocal  :: Bool,		-- True <=> it's defined in this module
+      iLocal  :: Bool,			-- True <=> it's defined in this module
       iDFunId :: DFunId,		-- The dfun id
       iBinds  :: RenamedMonoBinds,	-- Bindings, b
-      iLoc    :: SrcLoc,		-- Source location assoc'd with this instance's defn
       iPrags  :: [RenamedSig]		-- User pragmas recorded for generating specialised instances
     }
 
@@ -525,7 +519,8 @@ pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info))
 			 nest 4 (ppr (iBinds info))]
 
 simpleInstInfoTy :: InstInfo -> Type
-simpleInstInfoTy (InstInfo {iTys = [ty]}) = ty
+simpleInstInfoTy info = case splitDFunTy (idType (iDFunId info)) of
+			  (_, _, _, [ty]) -> ty
 
 simpleInstInfoTyCon :: InstInfo -> TyCon
   -- Gets the type constructor for a simple instance declaration,
@@ -533,9 +528,6 @@ simpleInstInfoTyCon :: InstInfo -> TyCon
 simpleInstInfoTyCon inst
    = case splitTyConApp_maybe (simpleInstInfoTy inst) of 
 	Just (tycon, _) -> tycon
-
-isLocalInst :: Module -> InstInfo -> Bool
-isLocalInst mod info = isLocalThing mod (iDFunId info)
 \end{code}
 
 
diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs
index a7e7d9fb50..02803412e1 100644
--- a/ghc/compiler/typecheck/TcInstDcls.lhs
+++ b/ghc/compiler/typecheck/TcInstDcls.lhs
@@ -30,14 +30,14 @@ import TcDeriv		( tcDeriving )
 import TcEnv		( TcEnv, tcExtendGlobalValEnv, 
 			  tcExtendTyVarEnvForMeths, 
 			  tcAddImportedIdInfo, tcInstId, tcLookupClass,
- 			  InstInfo(..), pprInstInfo, simpleInstInfoTyCon, simpleInstInfoTy, isLocalInst,
+ 			  InstInfo(..), pprInstInfo, simpleInstInfoTyCon, simpleInstInfoTy, 
 			  newDFunName, tcExtendTyVarEnv
 			)
 import InstEnv		( InstEnv, classDataCon, extendInstEnv )
 import TcMonoType	( tcTyVars, tcHsSigType, kcHsSigType )
 import TcSimplify	( tcSimplifyAndCheck )
 import TcType		( zonkTcSigTyVars )
-import HscTypes		( PersistentCompilerState(..), HomeSymbolTable, DFunId,
+import HscTypes		( HomeSymbolTable, DFunId,
 			  ModDetails(..), PackageInstEnv, PersistentRenamerState
 			)
 
@@ -48,18 +48,18 @@ import Maybes 		( maybeToBool )
 import MkId		( mkDictFunId )
 import Generics		( validGenericInstanceType )
 import Module		( Module, foldModuleEnv )
-import Name		( isLocallyDefined )
+import Name		( getSrcLoc )
 import NameSet		( emptyNameSet, nameSetToList )
 import PrelInfo		( eRROR_ID )
 import PprType		( pprConstraint, pprPred )
 import TyCon		( TyCon, isSynTyCon, tyConDerivings )
-import Type		( mkTyVarTys, splitDFunTy, isTyVarTy,
+import Type		( splitDFunTy, isTyVarTy,
 			  splitTyConApp_maybe, splitDictTy,
-			  splitAlgTyConApp_maybe, 
+			  splitAlgTyConApp_maybe, splitForAllTys,
 			  unUsgTy, tyVarsOfTypes, mkClassPred, mkTyVarTy,
 			  getClassTys_maybe
 			)
-import Subst		( mkTopTyVarSubst, substClasses, substTheta )
+import Subst		( mkTopTyVarSubst, substClasses )
 import VarSet		( mkVarSet, varSetElems )
 import TysWiredIn	( genericTyCons, isFFIArgumentTy, isFFIResultTy )
 import PrelNames	( cCallableClassKey, cReturnableClassKey, hasKey )
@@ -170,7 +170,7 @@ tcInstDecls1 :: PackageInstEnv
 	     -> [RenamedHsDecl]
 	     -> TcM (PackageInstEnv, InstEnv, [InstInfo], RenamedHsBinds)
 
-tcInstDecls1 inst_env0 prs hst unf_env get_fixity mod local_tycons decls
+tcInstDecls1 inst_env0 prs hst unf_env get_fixity mod tycons decls
   = let
 	inst_decls = [inst_decl | InstD inst_decl <- decls]
 	clas_decls = [clas_decl | TyClD clas_decl <- decls, isClassDecl clas_decl]
@@ -189,8 +189,7 @@ tcInstDecls1 inst_env0 prs hst unf_env get_fixity mod local_tycons decls
 	--	e) generic instances					inst_env4
 	-- The result of (b) replaces the cached InstEnv in the PCS
     let
-	(local_inst_info, imported_inst_info)
-	   = partition (isLocalInst mod) (concat inst_infos)
+	(local_inst_info, imported_inst_info) = partition iLocal (concat inst_infos)
 
 	imported_dfuns	 = map (tcAddImportedIdInfo unf_env . iDFunId) 
 			       imported_inst_info
@@ -206,8 +205,8 @@ tcInstDecls1 inst_env0 prs hst unf_env get_fixity mod local_tycons decls
 	--     we ignore deriving decls from interfaces!
 	-- This stuff computes a context for the derived instance decl, so it
 	-- needs to know about all the instances possible; hecne inst_env4
-    tcDeriving prs mod inst_env4 get_fixity local_tycons	`thenTc` \ (deriv_inst_info, deriv_binds) ->
-    addInstInfos inst_env4 deriv_inst_info			`thenNF_Tc` \ final_inst_env ->
+    tcDeriving prs mod inst_env4 get_fixity tycons	`thenTc` \ (deriv_inst_info, deriv_binds) ->
+    addInstInfos inst_env4 deriv_inst_info		`thenNF_Tc` \ final_inst_env ->
 
     returnTc (inst_env1, 
 	      final_inst_env, 
@@ -255,17 +254,18 @@ tcInstDecl1 mod unf_env (InstDecl poly_ty binds uprags maybe_dfun_name src_loc)
 
 		-- Make the dfun id and return it
 	    newDFunName mod clas inst_tys src_loc		`thenNF_Tc` \ dfun_name ->
-	    returnNF_Tc (True, mkDictFunId dfun_name clas tyvars inst_tys theta)
+	    returnNF_Tc (True, dfun_name)
 
 	Just dfun_name -> 	-- An interface-file instance declaration
     		-- Make the dfun id
-	    returnNF_Tc (False, mkDictFunId dfun_name clas tyvars inst_tys theta)
-    )						`thenNF_Tc` \ (is_local, dfun_id) ->
+	    returnNF_Tc (False, dfun_name)
+    )						`thenNF_Tc` \ (is_local, dfun_name) ->
 
-    returnTc [InstInfo { iLocal = is_local,
-			 iClass = clas, iTyVars = tyvars, iTys = inst_tys,
-			 iTheta = theta, iDFunId = dfun_id, 
-			 iBinds = binds, iLoc = src_loc, iPrags = uprags }]
+    let
+	dfun_id = mkDictFunId dfun_name clas tyvars inst_tys theta
+    in
+    returnTc [InstInfo { iLocal = is_local, iDFunId = dfun_id, 
+			 iBinds = binds,    iPrags = uprags }]
 \end{code}
 
 
@@ -334,15 +334,18 @@ get_generics mod decl@(ClassDecl context class_name tyvar_names
 	--	f {| x+y |} ... = ...
 	-- Then at this point we'll have an InstInfo for each
     let
-	bad_groups = [group | group <- equivClassesByUniq get_uniq inst_infos,
+	tc_inst_infos :: [(TyCon, InstInfo)]
+	tc_inst_infos = [(simpleInstInfoTyCon i, i) | i <- inst_infos]
+
+	bad_groups = [group | group <- equivClassesByUniq get_uniq tc_inst_infos,
 			      length group > 1]
-	get_uniq inst = getUnique (simpleInstInfoTyCon inst)
+	get_uniq (tc,_) = getUnique tc
     in
     mapTc (addErrTc . dupGenericInsts) bad_groups	`thenTc_`
 
 	-- Check that there is an InstInfo for each generic type constructor
     let
-	missing = genericTyCons `minusList` map simpleInstInfoTyCon inst_infos
+	missing = genericTyCons `minusList` [tc | (tc,_) <- tc_inst_infos]
     in
     checkTc (null missing) (missingGenericInstances missing)	`thenTc_`
 
@@ -399,10 +402,8 @@ mkGenericInstance mod clas loc (hs_ty, binds)
 	dfun_id    = mkDictFunId dfun_name clas tyvars inst_tys inst_theta
     in
 
-    returnTc (InstInfo { iLocal = True,
-			 iClass = clas, iTyVars = tyvars, iTys = inst_tys, 
-			 iTheta = inst_theta, iDFunId = dfun_id, iBinds = binds,
-			 iLoc = loc, iPrags = [] })
+    returnTc (InstInfo { iLocal = True, iDFunId = dfun_id, 
+		  	 iBinds = binds, iPrags = [] })
 \end{code}
 
 
@@ -496,16 +497,15 @@ First comes the easy case of a non-local instance decl.
 \begin{code}
 tcInstDecl2 :: InstInfo -> NF_TcM (LIE, TcMonoBinds)
 
-tcInstDecl2 (InstInfo { iClass = clas, iTyVars = inst_tyvars, iTys = inst_tys,
-			iTheta = inst_decl_theta, iDFunId = dfun_id,
-			iBinds = monobinds, iLoc = locn, iPrags = uprags })
-  | not (isLocallyDefined dfun_id)
+tcInstDecl2 (InstInfo { iLocal = is_local, iDFunId = dfun_id, 
+			iBinds = monobinds, iPrags = uprags })
+  | not is_local
   = returnNF_Tc (emptyLIE, EmptyMonoBinds)
 
   | otherwise
   =	 -- Prime error recovery
     recoverNF_Tc (returnNF_Tc (emptyLIE, EmptyMonoBinds))  $
-    tcAddSrcLoc locn					   $
+    tcAddSrcLoc (getSrcLoc dfun_id)			   $
 
 	-- Instantiate the instance decl with tc-style type variables
     tcInstId dfun_id		`thenNF_Tc` \ (inst_tyvars', dfun_theta', dict_ty') ->
@@ -518,15 +518,16 @@ tcInstDecl2 (InstInfo { iClass = clas, iTyVars = inst_tyvars, iTys = inst_tys,
 	dm_ids	  = [dm_id | (_, DefMeth dm_id) <- op_items]
 	sel_names = [idName sel_id | (sel_id, _) <- op_items]
 
-	-- Instantiate the theta found in the original instance decl
-	inst_decl_theta' = substTheta (mkTopTyVarSubst inst_tyvars (mkTyVarTys inst_tyvars'))
-				      inst_decl_theta
-
         -- Instantiate the super-class context with inst_tys
 	sc_theta' = substClasses (mkTopTyVarSubst class_tyvars inst_tys') sc_theta
 
 	-- Find any definitions in monobinds that aren't from the class
 	bad_bndrs = collectMonoBinders monobinds `minusList` sel_names
+
+	-- The type variable from the dict fun actually scope 
+	-- over the bindings.  They were gotten from
+	-- the original instance declaration
+	(inst_tyvars, _) = splitForAllTys (idType dfun_id)
     in
 	 -- Check that all the method bindings come from this class
     mapTc (addErrTc . badMethodErr clas) bad_bndrs		`thenNF_Tc_`
@@ -534,7 +535,6 @@ tcInstDecl2 (InstInfo { iClass = clas, iTyVars = inst_tyvars, iTys = inst_tys,
 	 -- Create dictionary Ids from the specified instance contexts.
     newClassDicts origin sc_theta'		`thenNF_Tc` \ (sc_dicts,        sc_dict_ids) ->
     newDicts origin dfun_theta'			`thenNF_Tc` \ (dfun_arg_dicts,  dfun_arg_dicts_ids)  ->
-    newDicts origin inst_decl_theta'		`thenNF_Tc` \ (inst_decl_dicts, _) ->
     newClassDicts origin [(clas,inst_tys')]	`thenNF_Tc` \ (this_dict,       [this_dict_id]) ->
 
     tcExtendTyVarEnvForMeths inst_tyvars inst_tyvars' (
@@ -542,7 +542,7 @@ tcInstDecl2 (InstInfo { iClass = clas, iTyVars = inst_tyvars, iTys = inst_tys,
 		-- Default-method Ids may be mentioned in synthesised RHSs 
 
 	mapAndUnzip3Tc (tcMethodBind clas origin inst_tyvars' inst_tys'
-				     inst_decl_theta'
+				     dfun_theta'
 				     monobinds uprags True)
 		       op_items
     ))		 	`thenTc` \ (method_binds_s, insts_needed_s, meth_lies_w_ids) ->
@@ -585,20 +585,6 @@ tcInstDecl2 (InstInfo { iClass = clas, iTyVars = inst_tyvars, iTys = inst_tys,
 		 methods_lie
     )						 `thenTc` \ (const_lie1, lie_binds1) ->
     
-	-- Check that we *could* construct the superclass dictionaries,
-	-- even though we are *actually* going to pass the superclass dicts in;
-	-- the check ensures that the caller will never have 
-	--a problem building them.
-    tcAddErrCtxt superClassCtxt (
-      tcSimplifyAndCheck
-		 (ptext SLIT("instance declaration context"))
-		 inst_tyvars_set		-- Local tyvars
-		 inst_decl_dicts		-- The instance dictionaries available
-		 sc_dicts			-- The superclass dicationaries reqd
-    )					`thenTc` \ _ -> 
-    						-- Ignore the result; we're only doing
-						-- this to make sure it can be done.
-
 	-- Now do the simplification again, this time to get the
 	-- bindings; this time we use an enhanced "avails"
 	-- Ignore errors because they come from the *previous* tcSimplify
@@ -791,11 +777,13 @@ missingGenericInstances missing
 	  
 
 
-dupGenericInsts inst_infos
+dupGenericInsts tc_inst_infos
   = vcat [ptext SLIT("More than one type pattern for a single generic type constructor:"),
-	  nest 4 (vcat (map (ppr . simpleInstInfoTy) inst_infos)),
+	  nest 4 (vcat (map ppr_inst_ty tc_inst_infos)),
 	  ptext SLIT("All the type patterns for a generic type constructor must be identical")
     ]
+  where 
+    ppr_inst_ty (tc,inst) = ppr (simpleInstInfoTy inst)
 
 instTypeErr clas tys msg
   = sep [ptext SLIT("Illegal instance declaration for") <+> quotes (pprConstraint clas tys),
@@ -814,7 +802,6 @@ nonBoxedPrimCCallErr clas inst_ty
     		        ppr inst_ty])
 
 methodCtxt     = ptext SLIT("When checking the methods of an instance declaration")
-superClassCtxt = ptext SLIT("When checking the superclasses of an instance declaration")
 \end{code}
 
  
diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs
index 0e13efb572..1387888d92 100644
--- a/ghc/compiler/typecheck/TcModule.lhs
+++ b/ghc/compiler/typecheck/TcModule.lhs
@@ -55,7 +55,7 @@ import Bag		( isEmptyBag )
 import Outputable
 import HscTypes		( PersistentCompilerState(..), HomeSymbolTable, HomeIfaceTable,
 			  PackageTypeEnv, DFunId, ModIface(..),
-			  TypeEnv, extendTypeEnvList, lookupTable,
+			  TypeEnv, extendTypeEnvList, lookupIface,
 		          TyThing(..), mkTypeEnv )
 import List		( partition )
 \end{code}
@@ -110,7 +110,7 @@ typecheckModule dflags this_mod pcs hst hit decls
     pit = pcs_PIT pcs
 
     get_fixity :: Name -> Maybe Fixity
-    get_fixity nm = lookupTable hit pit nm 	`thenMaybe` \ iface ->
+    get_fixity nm = lookupIface hit pit this_mod nm 	`thenMaybe` \ iface ->
 		    lookupNameEnv (mi_fixities iface) nm
 \end{code}
 
@@ -136,20 +136,14 @@ tcModule pcs hst get_fixity this_mod decls unf_env
     tcTyAndClassDecls unf_env decls		`thenTc` \ env ->
     tcSetEnv env 				$
     let
-        classes       = tcEnvClasses env
-        tycons        = tcEnvTyCons env	-- INCLUDES tycons derived from classes
-        local_tycons  = [ tc | tc <- tycons,
-    			       isLocallyDefined tc,
-    			       not (isClassTyCon tc)
-  	  	        ]
-    			-- For local_tycons, filter out the ones derived from classes
-    			-- Otherwise the latter show up in interface files
+        classes = tcEnvClasses env
+        tycons  = tcEnvTyCons env	-- INCLUDES tycons derived from classes
     in
     
     	-- Typecheck the instance decls, includes deriving
     tcInstDecls1 (pcs_insts pcs) (pcs_PRS pcs) 
 		 hst unf_env get_fixity this_mod 
-		 local_tycons decls		`thenTc` \ (new_pcs_insts, inst_env, local_inst_info, deriv_binds) ->
+		 tycons decls		`thenTc` \ (new_pcs_insts, inst_env, local_inst_info, deriv_binds) ->
     tcSetInstEnv inst_env			$
     
         -- Default declarations
@@ -173,8 +167,8 @@ tcModule pcs hst get_fixity this_mod decls unf_env
     -- We don't create bindings for dictionary constructors;
     -- they are always fully applied, and the bindings are just there
     -- to support partial applications
-    mkImplicitDataBinds tycons			`thenTc`    \ (data_ids, imp_data_binds) ->
-    mkImplicitClassBinds classes		`thenNF_Tc` \ (cls_ids,  imp_cls_binds) ->
+    mkImplicitDataBinds  this_mod tycons	`thenTc`    \ (data_ids, imp_data_binds) ->
+    mkImplicitClassBinds this_mod classes	`thenNF_Tc` \ (cls_ids,  imp_cls_binds) ->
     
     -- Extend the global value environment with 
     --	(a) constructors
@@ -201,7 +195,7 @@ tcModule pcs hst get_fixity this_mod decls unf_env
     	-- Second pass over class and instance declarations,
     	-- to compile the bindings themselves.
     tcInstDecls2  local_inst_info		`thenNF_Tc` \ (lie_instdecls, inst_binds) ->
-    tcClassDecls2 decls				`thenNF_Tc` \ (lie_clasdecls, cls_dm_binds) ->
+    tcClassDecls2 this_mod decls		`thenNF_Tc` \ (lie_clasdecls, cls_dm_binds) ->
     tcRules (pcs_rules pcs) this_mod decls	`thenNF_Tc` \ (new_pcs_rules, lie_rules, local_rules) ->
     
          -- Deal with constant or ambiguous InstIds.  How could
@@ -299,11 +293,7 @@ dump_sigs results	-- Print type signatures
     ppr_sig (n,t)        = ppr n <+> dcolon <+> ppr t
 
     want_sig id | opt_PprStyle_Debug = True
-	        | otherwise	     = isLocallyDefined n && 
-				       isGlobalName n && 
-				       not (isSysOcc (nameOccName n))
-				     where
-				       n = idName id
+	        | otherwise	     = isLocallyDefined id
 
 ppr_gen_tycons tcs = vcat [ptext SLIT("{-# Generic type constructor details"),
 			   vcat (map ppr_gen_tycon (filter isLocallyDefined tcs)),
diff --git a/ghc/compiler/typecheck/TcTyDecls.lhs b/ghc/compiler/typecheck/TcTyDecls.lhs
index c44fef24b0..b2d82be150 100644
--- a/ghc/compiler/typecheck/TcTyDecls.lhs
+++ b/ghc/compiler/typecheck/TcTyDecls.lhs
@@ -37,7 +37,8 @@ import DataCon		( DataCon, mkDataCon,
 import MkId		( mkDataConId, mkDataConWrapId, mkRecordSelId )
 import FieldLabel
 import Var		( Id, TyVar )
-import Name		( Name, isLocallyDefined, NamedThing(..) )
+import Module		( Module )
+import Name		( Name, NamedThing(..), isFrom )
 import Outputable
 import TyCon		( TyCon, isSynTyCon, isNewTyCon,
 			  tyConDataConsIfAvailable, tyConTyVars, tyConGenIds
@@ -216,15 +217,15 @@ getBangStrictness (Unpacked _) = markedUnboxed
 %************************************************************************
 
 \begin{code}
-mkImplicitDataBinds :: [TyCon] -> TcM ([Id], TcMonoBinds)
-mkImplicitDataBinds [] = returnTc ([], EmptyMonoBinds)
-mkImplicitDataBinds (tycon : tycons) 
-  | isSynTyCon tycon = mkImplicitDataBinds tycons
-  | otherwise	     = mkImplicitDataBinds_one tycon	`thenTc` \ (ids1, b1) ->
-		       mkImplicitDataBinds tycons	`thenTc` \ (ids2, b2) ->
+mkImplicitDataBinds :: Module -> [TyCon] -> TcM ([Id], TcMonoBinds)
+mkImplicitDataBinds this_mod [] = returnTc ([], EmptyMonoBinds)
+mkImplicitDataBinds this_mod (tycon : tycons) 
+  | isSynTyCon tycon = mkImplicitDataBinds this_mod tycons
+  | otherwise	     = mkImplicitDataBinds_one this_mod tycon	`thenTc` \ (ids1, b1) ->
+		       mkImplicitDataBinds this_mod tycons	`thenTc` \ (ids2, b2) ->
 		       returnTc (ids1++ids2, b1 `AndMonoBinds` b2)
 
-mkImplicitDataBinds_one tycon
+mkImplicitDataBinds_one this_mod tycon
   = mapTc (mkRecordSelector tycon) groups	`thenTc` \ sel_ids ->
     let
 	unf_ids = sel_ids ++ data_con_wrapper_ids ++ gen_ids
@@ -233,8 +234,8 @@ mkImplicitDataBinds_one tycon
 	-- For the locally-defined things
 	-- we need to turn the unfoldings inside the selector Ids into bindings,
 	-- and build bindigns for the constructor wrappers
-	binds | isLocallyDefined tycon = idsToMonoBinds unf_ids
-	      | otherwise	       = EmptyMonoBinds
+	binds | isFrom this_mod tycon = idsToMonoBinds unf_ids
+	      | otherwise 	      = EmptyMonoBinds
     in	
     returnTc (all_ids, binds)
   where