[project @ 2000-10-25 07:09:52 by simonpj]

More renamer stuff; still in flight

ghc/compiler/basicTypes/MkId.lhs

@@ -570,7 +570,7 @@ mkPrimOpId prim_op
 	   `setArityInfo` 	exactArity arity
 	   `setStrictnessInfo`	strict_info
 
-    rules = addRule id emptyCoreRules (primOpRule prim_op)
+    rules = addRule emptyCoreRules id (primOpRule prim_op)
 
 
 -- For each ccall we manufacture a separate CCallOpId, giving it

ghc/compiler/basicTypes/NameSet.lhs

@@ -9,7 +9,11 @@ module NameSet (
 	NameSet,
 	emptyNameSet, unitNameSet, mkNameSet, unionNameSets, unionManyNameSets,
 	minusNameSet, elemNameSet, nameSetToList, addOneToNameSet, addListToNameSet, 
-	delFromNameSet, delListFromNameSet, isEmptyNameSet, foldNameSet, filterNameSet
+	delFromNameSet, delListFromNameSet, isEmptyNameSet, foldNameSet, filterNameSet,
+	
+	-- Free variables
+	FreeVars, isEmptyFVs, emptyFVs, plusFVs, plusFV, 
+	mkFVs, addOneFV, unitFV, delFV, delFVs
     ) where
 
 #include "HsVersions.h"
@@ -62,3 +66,34 @@ delListFromNameSet set ns = foldl delFromNameSet set ns
 \end{code}
 
 
+%************************************************************************
+%*									*
+\subsection{Free variables}
+%*									*
+%************************************************************************
+
+These synonyms are useful when we are thinking of free variables
+
+\begin{code}
+type FreeVars	= NameSet
+
+plusFV   :: FreeVars -> FreeVars -> FreeVars
+addOneFV :: FreeVars -> Name -> FreeVars
+unitFV   :: Name -> FreeVars
+emptyFVs :: FreeVars
+plusFVs  :: [FreeVars] -> FreeVars
+mkFVs	 :: [Name] -> FreeVars
+delFV    :: Name -> FreeVars -> FreeVars
+delFVs   :: [Name] -> FreeVars -> FreeVars
+
+isEmptyFVs  = isEmptyNameSet
+emptyFVs    = emptyNameSet
+plusFVs     = unionManyNameSets
+plusFV      = unionNameSets
+mkFVs	    = mkNameSet
+addOneFV    = addOneToNameSet
+unitFV      = unitNameSet
+delFV n s   = delFromNameSet s n
+delFVs ns s = delListFromNameSet s ns
+\end{code}
+

ghc/compiler/basicTypes/RdrName.lhs

@@ -22,7 +22,7 @@ module RdrName (
 	-- Environment
 	RdrNameEnv, 
 	emptyRdrEnv, lookupRdrEnv, addListToRdrEnv, rdrEnvElts, 
-	extendRdrEnv, rdrEnvToList,
+	extendRdrEnv, rdrEnvToList, elemRdrEnv,
 
 	-- Printing;	instance Outputable RdrName
 	pprUnqualRdrName 
@@ -185,6 +185,7 @@ addListToRdrEnv :: RdrNameEnv a -> [(RdrName,a)] -> RdrNameEnv a
 extendRdrEnv	:: RdrNameEnv a -> RdrName -> a -> RdrNameEnv a
 rdrEnvToList    :: RdrNameEnv a -> [(RdrName, a)]
 rdrEnvElts	:: RdrNameEnv a -> [a]
+elemRdrEnv	:: RdrName -> RdrNameEnv a -> Bool
 
 emptyRdrEnv  = emptyFM
 lookupRdrEnv = lookupFM
@@ -192,4 +193,5 @@ addListToRdrEnv = addListToFM
 rdrEnvElts	= eltsFM
 extendRdrEnv    = addToFM
 rdrEnvToList    = fmToList
+elemRdrEnv      = elemFM
 \end{code}

ghc/compiler/basicTypes/VarSet.lhs

@@ -7,7 +7,7 @@
 module VarSet (
 	VarSet, IdSet, TyVarSet, UVarSet,
 	emptyVarSet, unitVarSet, mkVarSet,
-	extendVarSet,
+	extendVarSet, extendVarSet_C,
 	elemVarSet, varSetElems, subVarSet,
 	unionVarSet, unionVarSets,
 	intersectVarSet, intersectsVarSet,
@@ -18,12 +18,10 @@ module VarSet (
 
 #include "HsVersions.h"
 
-import CmdLineOpts	( opt_PprStyle_Debug )
-import Var		( Var, Id, TyVar, UVar, setVarUnique )
-import Unique		( Unique, Uniquable(..) )
+import Var		( Var, Id, TyVar, UVar )
+import Unique		( Unique )
 import UniqSet
-import UniqFM		( delFromUFM_Directly )
-import Outputable
+import UniqFM		( delFromUFM_Directly, addToUFM_C )
 \end{code}
 
 %************************************************************************
@@ -59,6 +57,7 @@ mapVarSet 	:: (Var -> Var) -> VarSet -> VarSet
 sizeVarSet	:: VarSet -> Int
 filterVarSet	:: (Var -> Bool) -> VarSet -> VarSet
 subVarSet	:: VarSet -> VarSet -> Bool
+extendVarSet_C  :: (Var->Var->Var) -> VarSet -> Var -> VarSet
 
 delVarSetByKey	:: VarSet -> Unique -> VarSet
 
@@ -80,6 +79,7 @@ lookupVarSet	= lookupUniqSet
 mapVarSet	= mapUniqSet
 sizeVarSet	= sizeUniqSet
 filterVarSet	= filterUniqSet
+extendVarSet_C combine s x = addToUFM_C combine s x x
 a `subVarSet` b = isEmptyVarSet (a `minusVarSet` b)
 delVarSetByKey	= delFromUFM_Directly	-- Can't be bothered to add this to UniqSet
 \end{code}

ghc/compiler/hsSyn/HsCore.lhs

@@ -14,11 +14,11 @@ We could either use this, or parameterise @GenCoreExpr@ on @Types@ and
 module HsCore (
 	UfExpr(..), UfAlt, UfBinder(..), UfNote(..),
 	UfBinding(..), UfConAlt(..),
-	HsIdInfo(..), pprHsIdInfo,
+	HsIdInfo(..), pprHsIdInfo, 
 
 	eq_ufExpr, eq_ufBinders, pprUfExpr,
 
-	toUfExpr, toUfBndr
+	toUfExpr, toUfBndr, ufBinderName
     ) where
 
 #include "HsVersions.h"
@@ -47,7 +47,6 @@ import DataCon		( dataConTyCon )
 import TyCon		( isTupleTyCon, tupleTyConBoxity )
 import Type		( Kind )
 import CostCentre
-import SrcLoc		( SrcLoc )
 import Outputable
 \end{code}
 
@@ -92,6 +91,10 @@ data UfBinding name
 data UfBinder name
   = UfValBinder	name (HsType name)
   | UfTyBinder	name Kind
+
+ufBinderName :: UfBinder name -> name
+ufBinderName (UfValBinder n _) = n
+ufBinderName (UfTyBinder  n _) = n
 \end{code}
 
 

ghc/compiler/hsSyn/HsDecls.lhs

@@ -16,7 +16,7 @@ module HsDecls (
 	DeprecDecl(..), DeprecTxt,
 	hsDeclName, instDeclName, tyClDeclName, tyClDeclNames,
 	isClassDecl, isSynDecl, isDataDecl, countTyClDecls, toHsRule,
-	mkClassDeclSysNames,
+	mkClassDeclSysNames, isIfaceRuleDecl,
 	getClassDeclSysNames
     ) where
 
@@ -237,7 +237,6 @@ mkClassDeclSysNames  (a,b,c,ds) = a:b:c:ds
 getClassDeclSysNames (a:b:c:ds) = (a,b,c,ds)
 \end{code}
 
-
 \begin{code}
 isDataDecl, isSynDecl, isClassDecl :: TyClDecl name pat -> Bool
 
@@ -373,7 +372,7 @@ data ConDecl name
 		name			-- Name of the constructor's 'worker Id'
 					-- Filled in as the ConDecl is built
 
-		[HsTyVarBndr name]		-- Existentially quantified type variables
+		[HsTyVarBndr name]	-- Existentially quantified type variables
 		(HsContext name)	-- ...and context
 					-- If both are empty then there are no existentials
 
@@ -632,6 +631,8 @@ data RuleDecl name pat
 	name			-- Head of LHS
 	CoreRule
 
+isIfaceRuleDecl (HsRule _ _ _ _ _ _) = False
+isIfaceRuleDecl other		     = True
 
 data RuleBndr name
   = RuleBndr name

ghc/compiler/main/HscTypes.lhs

@@ -52,6 +52,7 @@ import OccName		( OccName )
 import Module		( Module, ModuleName, ModuleEnv,
 			  lookupModuleEnv, lookupModuleEnvByName
 			)
+import Rules		( RuleBase )
 import VarSet		( TyVarSet )
 import VarEnv		( emptyVarEnv )
 import Id		( Id )
@@ -149,7 +150,7 @@ data ModDetails
 	-- The next three fields are created by the typechecker
         md_types    :: TypeEnv,
         md_insts    :: [DFunId],	-- Dfun-ids for the instances in this module
-        md_rules    :: RuleBase		-- Domain may include Ids from other modules
+        md_rules    :: [(Id,CoreRule)]	-- Domain may include Ids from other modules
      }
 \end{code}
 
@@ -158,7 +159,7 @@ emptyModDetails :: ModDetails
 emptyModDetails
   = ModDetails { md_types = emptyTypeEnv,
                  md_insts = [],
-                 md_rules = emptyRuleBase
+                 md_rules = []
     }
 
 emptyModIface :: Module -> ModIface
@@ -386,7 +387,7 @@ data PersistentCompilerState
 	pcs_insts :: PackageInstEnv,	-- The total InstEnv accumulated from all
 					--   the non-home-package modules
 
-	pcs_rules :: PackageRuleEnv,	-- Ditto RuleEnv
+	pcs_rules :: PackageRuleBase,	-- Ditto RuleEnv
 
         pcs_PRS :: PersistentRenamerState
      }

ghc/compiler/rename/RnBinds.lhs

@@ -18,7 +18,7 @@ module RnBinds (
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} RnSource ( rnHsSigType )
+import {-# SOURCE #-} RnSource ( rnHsSigType, rnHsType )
 
 import HsSyn
 import HsBinds		( eqHsSig, sigName, hsSigDoc )
@@ -483,11 +483,12 @@ renameSigs ::  (RenamedSig -> Bool)		-- OK-sig predicate
 	    -> [RdrNameSig]
 	    -> RnMS ([RenamedSig], FreeVars)
 
-renameSigs ok_sig [] = returnRn ([], emptyFVs)	-- Common shortcut
+renameSigs ok_sig []
+  = returnRn ([], emptyFVs)	-- Common shortcut
 
 renameSigs ok_sig sigs
   =	 -- Rename the signatures
-    mapFvRn renameSig sigs   	`thenRn` \ (sigs', fvs) ->
+    mapRn renameSig sigs   	`thenRn` \ sigs' ->
 
 	-- Check for (a) duplicate signatures
 	--	     (b) signatures for things not in this group
@@ -499,7 +500,7 @@ renameSigs ok_sig sigs
 	(goods, bads)	 = partition ok_sig in_scope
     in
     mapRn_ unknownSigErr bads			`thenRn_`
-    returnRn (goods, fvs)
+    returnRn (goods, hsSigFVs goods)
 
 -- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory
 -- because this won't work for:
@@ -510,39 +511,39 @@ renameSigs ok_sig sigs
 -- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)
 -- Doesn't seem worth much trouble to sort this.
 
-renameSig :: Sig RdrName -> RnMS (Sig Name, FreeVars)
+renameSig :: Sig RdrName -> RnMS (Sig Name)
 -- ClassOpSig is renamed elsewhere.
 renameSig (Sig v ty src_loc)
   = pushSrcLocRn src_loc $
     lookupSigOccRn v				`thenRn` \ new_v ->
-    rnHsSigType (quotes (ppr v)) ty		`thenRn` \ (new_ty,fvs) ->
-    returnRn (Sig new_v new_ty src_loc, fvs `addOneFV` new_v)
+    rnHsSigType (quotes (ppr v)) ty		`thenRn` \ new_ty ->
+    returnRn (Sig new_v new_ty src_loc)
 
 renameSig (SpecInstSig ty src_loc)
   = pushSrcLocRn src_loc $
-    rnHsSigType (text "A SPECIALISE instance pragma") ty `thenRn` \ (new_ty, fvs) ->
-    returnRn (SpecInstSig new_ty src_loc, fvs)
+    rnHsType (text "A SPECIALISE instance pragma") ty `thenRn` \ new_ty ->
+    returnRn (SpecInstSig new_ty src_loc)
 
 renameSig (SpecSig v ty src_loc)
   = pushSrcLocRn src_loc $
     lookupSigOccRn v			`thenRn` \ new_v ->
-    rnHsSigType (quotes (ppr v)) ty	`thenRn` \ (new_ty,fvs) ->
-    returnRn (SpecSig new_v new_ty src_loc, fvs `addOneFV` new_v)
+    rnHsSigType (quotes (ppr v)) ty	`thenRn` \ new_ty ->
+    returnRn (SpecSig new_v new_ty src_loc)
 
 renameSig (FixSig (FixitySig v fix src_loc))
   = pushSrcLocRn src_loc $
     lookupSigOccRn v		`thenRn` \ new_v ->
-    returnRn (FixSig (FixitySig new_v fix src_loc), unitFV new_v)
+    returnRn (FixSig (FixitySig new_v fix src_loc))
 
 renameSig (InlineSig v p src_loc)
   = pushSrcLocRn src_loc $
     lookupSigOccRn v		`thenRn` \ new_v ->
-    returnRn (InlineSig new_v p src_loc, unitFV new_v)
+    returnRn (InlineSig new_v p src_loc)
 
 renameSig (NoInlineSig v p src_loc)
   = pushSrcLocRn src_loc $
     lookupSigOccRn v		`thenRn` \ new_v ->
-    returnRn (NoInlineSig new_v p src_loc, unitFV new_v)
+    returnRn (NoInlineSig new_v p src_loc)
 \end{code}
 
 \begin{code}

ghc/compiler/rename/RnEnv.lhs

@@ -670,25 +670,6 @@ pprAvail (Avail n) = ppr n
 %************************************************************************
 
 \begin{code}
-type FreeVars	= NameSet
-
-plusFV   :: FreeVars -> FreeVars -> FreeVars
-addOneFV :: FreeVars -> Name -> FreeVars
-unitFV   :: Name -> FreeVars
-emptyFVs :: FreeVars
-plusFVs  :: [FreeVars] -> FreeVars
-mkFVs	 :: [Name] -> FreeVars
-
-isEmptyFVs = isEmptyNameSet
-emptyFVs   = emptyNameSet
-plusFVs    = unionManyNameSets
-plusFV     = unionNameSets
-mkFVs	   = mkNameSet
-
--- No point in adding implicitly imported names to the free-var set
-addOneFV s n = addOneToNameSet s n
-unitFV     n = unitNameSet n
-
 -- A useful utility
 mapFvRn f xs = mapRn f xs	`thenRn` \ stuff ->
 	       let

ghc/compiler/rename/RnExpr.lhs

@@ -18,14 +18,14 @@ module RnExpr (
 #include "HsVersions.h"
 
 import {-# SOURCE #-} RnBinds  ( rnBinds ) 
-import {-# SOURCE #-} RnSource ( rnHsSigType, rnHsType )
+import {-# SOURCE #-} RnSource ( rnHsTypeFVs )
 
 import HsSyn
 import RdrHsSyn
 import RnHsSyn
 import RnMonad
 import RnEnv
-import RnIfaces		( lookupFixityRn )
+import RnHiFiles	( lookupFixityRn )
 import CmdLineOpts	( DynFlag(..), opt_IgnoreAsserts )
 import Literal		( inIntRange )
 import BasicTypes	( Fixity(..), FixityDirection(..), defaultFixity, negateFixity )
@@ -71,7 +71,7 @@ rnPat (SigPatIn pat ty)
     
     if glaExts
     then rnPat pat		`thenRn` \ (pat', fvs1) ->
-         rnHsType doc ty	`thenRn` \ (ty',  fvs2) ->
+         rnHsTypeFVs doc ty	`thenRn` \ (ty',  fvs2) ->
          returnRn (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
 
     else addErrRn (patSigErr ty)	`thenRn_`
@@ -146,7 +146,7 @@ rnPat (RecPatIn con rpats)
     rnRpats rpats	`thenRn` \ (rpats', fvs) ->
     returnRn (RecPatIn con' rpats', fvs `addOneFV` con')
 rnPat (TypePatIn name) =
-    (rnHsType (text "type pattern") name) `thenRn` \ (name', fvs) ->
+    (rnHsTypeFVs (text "type pattern") name) `thenRn` \ (name', fvs) ->
     returnRn (TypePatIn name', fvs)
 \end{code}
 
@@ -187,7 +187,7 @@ rnMatch match@(Match _ pats maybe_rhs_sig grhss)
     doptRn Opt_GlasgowExts		`thenRn` \ opt_GlasgowExts ->
     (case maybe_rhs_sig of
 	Nothing -> returnRn (Nothing, emptyFVs)
-	Just ty | opt_GlasgowExts -> rnHsType doc_sig ty	`thenRn` \ (ty', ty_fvs) ->
+	Just ty | opt_GlasgowExts -> rnHsTypeFVs doc_sig ty	`thenRn` \ (ty', ty_fvs) ->
 				     returnRn (Just ty', ty_fvs)
 		| otherwise	  -> addErrRn (patSigErr ty)	`thenRn_`
 				     returnRn (Nothing, emptyFVs)
@@ -411,8 +411,8 @@ rnExpr (RecordUpd expr rbinds)
     returnRn (RecordUpd expr' rbinds', fvExpr `plusFV` fvRbinds)
 
 rnExpr (ExprWithTySig expr pty)
-  = rnExpr expr			 		`thenRn` \ (expr', fvExpr) ->
-    rnHsSigType (text "an expression") pty	`thenRn` \ (pty', fvTy) ->
+  = rnExpr expr			 			   `thenRn` \ (expr', fvExpr) ->
+    rnHsTypeFVs (text "an expression type signature") pty  `thenRn` \ (pty', fvTy) ->
     returnRn (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy)
 
 rnExpr (HsIf p b1 b2 src_loc)
@@ -422,10 +422,11 @@ rnExpr (HsIf p b1 b2 src_loc)
     rnExpr b2		`thenRn` \ (b2', fvB2) ->
     returnRn (HsIf p' b1' b2' src_loc, plusFVs [fvP, fvB1, fvB2])
 
-rnExpr (HsType a) = 
-    (rnHsType doc a) `thenRn` \ (t, fvT) -> returnRn (HsType t, fvT)
-       where doc = text "renaming a type pattern"
-		    
+rnExpr (HsType a)
+  = rnHsTypeFVs doc a	`thenRn` \ (t, fvT) -> 
+    returnRn (HsType t, fvT)
+  where 
+    doc = text "renaming a type pattern"
 
 rnExpr (ArithSeqIn seq)
   = lookupOrigName enumClass_RDR	`thenRn` \ enum ->

ghc/compiler/rename/RnHiFiles.lhs

@@ -9,6 +9,8 @@ module RnHiFiles (
 	tryLoadInterface, loadOrphanModules,
 	loadExports, loadFixDecls, loadDeprecs,
 
+	lookupFixityRn, 
+
 	getTyClDeclBinders, 
 	removeContext	 	-- removeContext probably belongs somewhere else
    ) where
@@ -541,6 +543,39 @@ readIface wanted_mod file_path
 \end{code}
 
 
+%*********************************************************
+%*							*
+\subsection{Looking up fixities}
+%*							*
+%*********************************************************
+
+This has to be in RnIfaces (or RnHiFiles) because it calls loadHomeInterface
+
+\begin{code}
+lookupFixityRn :: Name -> RnMS Fixity
+lookupFixityRn name
+  | isLocallyDefined name
+  = getFixityEnv			`thenRn` \ local_fix_env ->
+    returnRn (lookupLocalFixity local_fix_env name)
+
+  | otherwise	-- 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,
+      -- which exports a function 'f', which is defined in module B.  Then B isn't loaded
+      -- 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` \ ifaces ->
+    case lookupTable hit (iPIT ifaces) name of
+	Just iface -> returnRn (lookupNameEnv (mi_fixities iface) name `orElse` defaultFixity)
+	Nothing	   -> returnRn defaultFixity
+  where
+    doc = ptext SLIT("Checking fixity for") <+> ppr name
+\end{code}
+
+
 %*********************************************************
 %*						 	 *
 \subsection{Errors}

ghc/compiler/rename/RnHsSyn.lhs

@@ -9,10 +9,13 @@ module RnHsSyn where
 #include "HsVersions.h"
 
 import HsSyn
+import HsCore
+import Class		( FunDep, DefMeth(..) )
 import TysWiredIn	( tupleTyCon, listTyCon, charTyCon )
 import Name		( Name, getName, isTyVarName )
 import NameSet
 import BasicTypes	( Boxity )
+import Maybes		( orElse )
 import Outputable
 \end{code}
 
@@ -65,6 +68,9 @@ tupleTyCon_name boxity n = getName (tupleTyCon boxity n)
 extractHsTyVars :: RenamedHsType -> NameSet
 extractHsTyVars x = filterNameSet isTyVarName (extractHsTyNames x)
 
+extractFunDepNames :: FunDep Name -> NameSet
+extractFunDepNames (ns1, ns2) = mkNameSet ns1 `unionNameSets` mkNameSet ns2
+
 extractHsTyNames   :: RenamedHsType -> NameSet
 extractHsTyNames ty
   = get ty
@@ -102,6 +108,111 @@ extractHsPredTyNames (HsPIParam n ty)
 \end{code}
 
 
+%************************************************************************
+%*									*
+\subsection{Free variables of declarations}
+%*									*
+%************************************************************************
+
+Return the Names that must be in scope if we are to use this declaration.
+In all cases this is set up for interface-file declarations:
+	- for class decls we ignroe the bindings
+	- for instance decls likewise, plus the pragmas
+	- for rule decls, we ignore HsRules
+
+\begin{code}
+tyClDeclFVs :: RenamedTyClDecl -> NameSet
+tyClDeclFVs (IfaceSig name ty id_infos loc)
+  = extractHsTyNames ty			`plusFV` 
+    plusFVs (map hsIdInfoFVs id_infos)
+
+tyClDeclFVs (TyData _ context _ tyvars condecls _ derivings _ _ _)
+  = delFVs (map hsTyVarName tyvars) $
+    extractHsCtxtTyNames context	`plusFV`
+    plusFVs (map conDeclFVs condecls)	`plusFV`
+    mkNameSet (derivings `orElse` [])
+
+tyClDeclFVs (TySynonym _ tyvars ty _)
+  = delFVs (map hsTyVarName tyvars) (extractHsTyNames ty)
+
+tyClDeclFVs (ClassDecl context _ tyvars fds sigs _ _ src_loc)
+  = delFVs (map hsTyVarName tyvars) $
+    extractHsCtxtTyNames context	  `plusFV`
+    plusFVs (map extractFunDepNames fds)  `plusFV`
+    plusFVs (map hsSigFVs sigs)
+
+----------------
+hsSigFVs (Sig v ty _) 	    	    = extractHsTyNames ty `addOneFV` v
+hsSigFVs (SpecInstSig ty _) 	    = extractHsTyNames ty
+hsSigFVs (SpecSig v ty _)   	    = extractHsTyNames ty `addOneFV` v
+hsSigFVs (FixSig (FixitySig v _ _)) = unitFV v
+hsSigFVs (InlineSig v p _) 	    = unitFV v
+hsSigFVs (NoInlineSig v p _)	    = unitFV v
+hsSigFVs (ClassOpSig v dm ty _)	    = dmFVs dm `plusFV` extractHsTyNames ty `addOneFV` v
+
+dmFVs (Just (DefMeth v)) = unitFV v
+dmFVs other		 = emptyFVs
+
+----------------
+instDeclFVs (InstDecl inst_ty _ _ maybe_dfun _)
+  = extractHsTyNames inst_ty	`plusFV` 
+    (case maybe_dfun of { Just n -> unitFV n; Nothing -> emptyFVs })
+
+----------------
+ruleDeclFVs (HsRule _ _ _ _ _ _) = emptyFVs
+ruleDeclFVs (IfaceRule _ vars _ _ rhs _)
+  = delFVs (map ufBinderName vars) $
+    ufExprFVs rhs
+
+----------------
+conDeclFVs (ConDecl _ _ tyvars context details _)
+  = delFVs (map hsTyVarName tyvars) $
+    extractHsCtxtTyNames context	  `plusFV`
+    conDetailsFVs details
+
+conDetailsFVs (VanillaCon btys)    = plusFVs (map bangTyFVs btys)
+conDetailsFVs (InfixCon bty1 bty2) = bangTyFVs bty1 `plusFV` bangTyFVs bty2
+conDetailsFVs (RecCon flds)	   = plusFVs [bangTyFVs bty | (_, bty) <- flds]
+
+bangTyFVs bty = extractHsTyNames (getBangType bty)
+
+----------------
+hsIdInfoFVs (HsUnfold _ unf) = ufExprFVs unf
+hsIdInfoFVs (HsWorker n)     = unitFV n
+hsIdInfoFVs other	     = emptyFVs
+
+----------------
+ufExprFVs (UfVar n) 	  = unitFV n
+ufExprFVs (UfLit l) 	  = emptyFVs
+ufExprFVs (UfLitLit l ty) = extractHsTyNames ty
+ufExprFVs (UfCCall cc ty) = extractHsTyNames ty
+ufExprFVs (UfType ty)     = extractHsTyNames ty
+ufExprFVs (UfTuple tc es) = hsTupConFVs tc `plusFV` plusFVs (map ufExprFVs es)
+ufExprFVs (UfLam v e)     = ufBndrFVs v (ufExprFVs e)
+ufExprFVs (UfApp e1 e2)   = ufExprFVs e1 `plusFV` ufExprFVs e2
+ufExprFVs (UfCase e n as) = ufExprFVs e `plusFV` delFV n (plusFVs (map ufAltFVs as))
+ufExprFVs (UfNote n e)	  = ufNoteFVs n `plusFV` ufExprFVs e
+ufExprFVs (UfLet (UfNonRec b r) e) = ufExprFVs r `plusFV` ufBndrFVs b (ufExprFVs e)
+ufExprFVs (UfLet (UfRec prs)    e) = foldr ufBndrFVs 
+					   (foldr (plusFV . ufExprFVs . snd) (ufExprFVs e) prs)
+					   (map fst prs) 
+
+ufBndrFVs (UfValBinder n ty) fvs = extractHsTyNames ty `plusFV` delFV n fvs
+ufBndrFVs (UfTyBinder  n k)  fvs = delFV n fvs
+
+ufAltFVs (con, vs, e) = ufConFVs con `plusFV` delFVs vs (ufExprFVs e)
+
+ufConFVs (UfDataAlt n)      = unitFV n
+ufConFVs (UfTupleAlt t)     = hsTupConFVs t
+ufConFVs (UfLitLitAlt _ ty) = extractHsTyNames ty
+ufConFVs other		    = emptyFVs
+
+ufNoteFVs (UfCoerce ty) = extractHsTyNames ty
+ufNoteFVs note		= emptyFVs
+
+hsTupConFVs (HsTupCon n _) = unitFV n
+\end{code}
+
 %************************************************************************
 %*									*
 \subsection{A few functions on generic defintions

ghc/compiler/rename/RnIfaces.lhs

@@ -5,12 +5,12 @@
 
 \begin{code}
 module RnIfaces
-       (
+     (
 	getInterfaceExports,
-	getImportedInstDecls, getImportedRules,
-	lookupFixityRn, 
-	importDecl, ImportDeclResult(..), recordLocalSlurps, 
-	mkImportInfo, getSlurped,
+	recordLocalSlurps, 
+	mkImportInfo, 
+
+	slurpImpDecls, 
 
 	RecompileRequired, outOfDate, upToDate, recompileRequired
        )
@@ -27,6 +27,7 @@ import RdrHsSyn		( RdrNameHsDecl, RdrNameTyClDecl, RdrNameInstDecl )
 import RnHiFiles	( tryLoadInterface, loadHomeInterface, loadInterface, 
 			  loadOrphanModules
 			)
+import RnSource		( rnTyClDecl, rnDecl )
 import RnEnv
 import RnMonad
 import Name		( Name {-instance NamedThing-}, nameOccName,
@@ -79,39 +80,6 @@ getInterfaceExports mod_name from
 \end{code}
 
 
-%*********************************************************
-%*							*
-\subsection{Instance declarations are handled specially}
-%*							*
-%*********************************************************
-
-This has to be in RnIfaces (or RnHiFiles) because it calls loadHomeInterface
-
-\begin{code}
-lookupFixityRn :: Name -> RnMS Fixity
-lookupFixityRn name
-  | isLocallyDefined name
-  = getFixityEnv			`thenRn` \ local_fix_env ->
-    returnRn (lookupLocalFixity local_fix_env name)
-
-  | otherwise	-- 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,
-      -- which exports a function 'f', which is defined in module B.  Then B isn't loaded
-      -- 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` \ ifaces ->
-    case lookupTable hit (iPIT ifaces) name of
-	Just iface -> returnRn (lookupNameEnv (mi_fixities iface) name `orElse` defaultFixity)
-	Nothing	   -> returnRn defaultFixity
-  where
-    doc = ptext SLIT("Checking fixity for") <+> ppr name
-\end{code}