Fix Trac #2713: refactor and tidy up renaming of fixity decls

In fixing #2713, this patch also eliminates two almost-unused
functions from RnEnv (lookupBndr and lookupBndr_maybe).  The
net lines of code is prety much unchanged, but more of them
are comments!

compiler/rename/RnBinds.lhs

@@ -28,7 +28,6 @@ import RnPat          (rnPatsAndThen_LocalRightwards, rnBindPat,
                       )
                       
 import RnEnv
-import PrelNames	( mkUnboundName )
 import DynFlags	( DynFlag(..) )
 import Name
 import NameEnv
@@ -161,7 +160,7 @@ rnTopBindsLHS :: MiniFixityEnv
 rnTopBindsLHS fix_env binds = 
     (uncurry $ rnValBindsLHSFromDoc (topRecNameMaker fix_env)) (bindersAndDoc binds) binds
 
-rnTopBindsRHS :: [Name] -- the names bound by these binds
+rnTopBindsRHS :: NameSet	-- Names bound by these binds
               -> HsValBindsLR Name RdrName 
               -> RnM (HsValBinds Name, DefUses)
 rnTopBindsRHS bound_names binds = 
@@ -170,18 +169,17 @@ rnTopBindsRHS bound_names binds =
          then rnTopBindsBoot binds
          else rnValBindsRHSGen (\x -> x) -- don't trim free vars
                                bound_names binds }
-  
 
--- wrapper if we don't need to do anything in between the left and right,
+-- Wrapper if we don't need to do anything in between the left and right,
 -- or anything else in the scope of the left
 --
--- never used when there are fixity declarations
+-- Never used when there are fixity declarations
 rnTopBinds :: HsValBinds RdrName 
            -> RnM (HsValBinds Name, DefUses)
 rnTopBinds b = 
   do nl <- rnTopBindsLHS emptyFsEnv b
      let bound_names = map unLoc (collectHsValBinders nl)
-     bindLocalNames bound_names  $ rnTopBindsRHS bound_names nl
+     bindLocalNames bound_names $ rnTopBindsRHS (mkNameSet bound_names) nl
        
 
 rnTopBindsBoot :: HsValBindsLR Name RdrName -> RnM (HsValBinds Name, DefUses)
@@ -306,13 +304,13 @@ rnValBindsLHSFromDoc _ _ _ b = pprPanic "rnValBindsLHSFromDoc" (ppr b)
 rnValBindsRHSGen :: (FreeVars -> FreeVars)  -- for trimming free var sets
                      -- The trimming function trims the free vars we attach to a
                      -- binding so that it stays reasonably small
-                 -> [Name]  -- names bound by the LHSes
+                 -> NameSet	-- Names bound by the LHSes
                  -> HsValBindsLR Name RdrName
                  -> RnM (HsValBinds Name, DefUses)
 
 rnValBindsRHSGen trim bound_names (ValBindsIn mbinds sigs) = do
    -- rename the sigs
-   sigs' <- renameSigs (Just (mkNameSet bound_names)) okBindSig sigs
+   sigs' <- renameSigs (Just bound_names) okBindSig sigs
    -- rename the RHSes
    binds_w_dus <- mapBagM (rnBind (mkSigTvFn sigs') trim) mbinds
    case depAnalBinds binds_w_dus of
@@ -329,12 +327,12 @@ rnValBindsRHSGen _ _ b = pprPanic "rnValBindsRHSGen" (ppr b)
 -- it doesn't (and can't: we don't have the thing inside the binds) happen here
 --
 -- The client is also responsible for bringing the fixities into scope
-rnValBindsRHS :: [Name]  -- names bound by the LHSes
+rnValBindsRHS :: NameSet  -- names bound by the LHSes
               -> HsValBindsLR Name RdrName
               -> RnM (HsValBinds Name, DefUses)
 rnValBindsRHS bound_names binds = 
   rnValBindsRHSGen (\ fvs -> -- only keep the names the names from this group
-                    intersectNameSet (mkNameSet bound_names) fvs) bound_names binds
+                    intersectNameSet bound_names fvs) bound_names binds
 
 
 -- for local binds
@@ -359,7 +357,7 @@ rnValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside
 	; bindLocalNamesFV_WithFixities bound_names new_fixities $ do
 
 	{      -- (C) Do the RHS and thing inside
-	  (binds', dus) <- rnValBindsRHS bound_names new_lhs 
+	  (binds', dus) <- rnValBindsRHS (mkNameSet bound_names) new_lhs 
         ; (result, result_fvs) <- thing_inside binds'
 
 		-- Report unused bindings based on the (accurate) 
@@ -721,7 +719,7 @@ renameSigs mb_names ok_sig sigs
 renameSig :: Maybe NameSet -> Sig RdrName -> RnM (Sig Name)
 -- FixitySig is renamed elsewhere.
 renameSig mb_names sig@(TypeSig v ty)
-  = do	{ new_v <- lookupSigLocOccRn mb_names sig v
+  = do	{ new_v <- lookupSigOccRn mb_names sig v
 	; new_ty <- rnHsSigType (quotes (ppr v)) ty
 	; return (TypeSig new_v new_ty) }
 
@@ -730,68 +728,17 @@ renameSig _ (SpecInstSig ty)
 	; return (SpecInstSig new_ty) }
 
 renameSig mb_names sig@(SpecSig v ty inl)
-  = do	{ new_v <- lookupSigLocOccRn mb_names sig v
+  = do	{ new_v <- lookupSigOccRn mb_names sig v
 	; new_ty <- rnHsSigType (quotes (ppr v)) ty
 	; return (SpecSig new_v new_ty inl) }
 
 renameSig mb_names sig@(InlineSig v s)
-  = do	{ new_v <- lookupSigLocOccRn mb_names sig v
+  = do	{ new_v <- lookupSigOccRn mb_names sig v
 	; return (InlineSig new_v s) }
 
 renameSig mb_names sig@(FixSig (FixitySig v f))
-  = do	{ new_v <- lookupSigLocOccRn mb_names sig v
+  = do	{ new_v <- lookupSigOccRn mb_names sig v
 	; return (FixSig (FixitySig new_v f)) }
-
--- lookupSigOccRn is used for type signatures and pragmas
--- Is this valid?
---   module A
---	import M( f )
---	f :: Int -> Int
---	f x = x
--- It's clear that the 'f' in the signature must refer to A.f
--- The Haskell98 report does not stipulate this, but it will!
--- So we must treat the 'f' in the signature in the same way
--- as the binding occurrence of 'f', using lookupBndrRn
---
--- However, consider this case:
---	import M( f )
---	f :: Int -> Int
---	g x = x
--- We don't want to say 'f' is out of scope; instead, we want to
--- return the imported 'f', so that later on the reanamer will
--- correctly report "misplaced type sig".
-
-lookupSigLocOccRn :: Maybe NameSet -> Sig RdrName -> Located RdrName -> RnM (Located Name)
-lookupSigLocOccRn mb_names sig = wrapLocM (lookupSigOccRn mb_names sig)
-
-lookupSigOccRn :: Maybe NameSet -> Sig RdrName -> RdrName -> RnM Name
-lookupSigOccRn mb_names sig v
-  = do 	{ mb_n <- lookupBndrRn_maybe v
-	; case mb_n of {
-	    Just n  -> case mb_names of {
-			Nothing 		     -> return n ;
-			Just ns | n `elemNameSet` ns -> return n 
-				| otherwise -> bale_out_with local_msg } ;
-		          
-	    Nothing -> do
-    	{ mb_n <- lookupGreRn_maybe v
-	; case mb_n of
-	    Just _  -> bale_out_with import_msg
-	    Nothing -> bale_out_with empty
-	} }}
-  where
-    bale_out_with msg 
-	= do { addErr (sep [ ptext (sLit "The") <+> hsSigDoc sig
-				<+> ptext (sLit "for") <+> quotes (ppr v)
-			   , nest 2 $ ptext (sLit "lacks an accompanying binding")]
-		       $$ nest 2 msg)
-	     ; return (mkUnboundName v) }
-
-    local_msg = parens $ ptext (sLit "The")  <+> hsSigDoc sig <+> ptext (sLit "must be given where")
-			 <+> quotes (ppr v) <+> ptext (sLit "is declared")
-
-    import_msg = parens $ ptext (sLit "You cannot give a") <+> hsSigDoc sig
-			  <+> ptext (sLit "an imported value")
 \end{code}
 
 

compiler/rename/RnEnv.lhs

@@ -6,11 +6,11 @@
 \begin{code}
 module RnEnv ( 
 	newTopSrcBinder, lookupFamInstDeclBndr,
-	lookupLocatedBndrRn, lookupBndrRn, lookupBndrRn_maybe,
 	lookupLocatedTopBndrRn, lookupTopBndrRn,
 	lookupLocatedOccRn, lookupOccRn, 
 	lookupLocatedGlobalOccRn, lookupGlobalOccRn,
 	lookupLocalDataTcNames, lookupSrcOcc_maybe,
+	lookupSigOccRn,
 	lookupFixityRn, lookupTyFixityRn, 
 	lookupInstDeclBndr, lookupRecordBndr, lookupConstructorFields,
 	lookupSyntaxName, lookupSyntaxTable, lookupImportedName,
@@ -55,6 +55,7 @@ import PrelNames	( mkUnboundName, rOOT_MAIN, iNTERACTIVE,
 			  consDataConKey, hasKey, forall_tv_RDR )
 import UniqSupply
 import BasicTypes	( IPName, mapIPName, Fixity )
+import ErrUtils		( Message )
 import SrcLoc
 import Outputable
 import Util
@@ -161,16 +162,6 @@ newTopSrcBinder this_mod (L loc rdr_name)
 Looking up a name in the RnEnv.
 
 \begin{code}
-lookupLocatedBndrRn :: Located RdrName -> RnM (Located Name)
-lookupLocatedBndrRn = wrapLocM lookupBndrRn
-
-lookupBndrRn :: RdrName -> RnM Name
-lookupBndrRn n = do nopt <- lookupBndrRn_maybe n
-                    case nopt of 
-                      Just n' -> return n'
-                      Nothing -> do traceRn $ text "lookupTopBndrRn"
-                                    unboundName n
-
 lookupTopBndrRn :: RdrName -> RnM Name
 lookupTopBndrRn n = do nopt <- lookupTopBndrRn_maybe n
                        case nopt of 
@@ -178,14 +169,6 @@ lookupTopBndrRn n = do nopt <- lookupTopBndrRn_maybe n
                          Nothing -> do traceRn $ text "lookupTopBndrRn"
                                        unboundName n
 
-lookupBndrRn_maybe :: RdrName -> RnM (Maybe Name)
--- NOTE: assumes that the SrcSpan of the binder has already been setSrcSpan'd
-lookupBndrRn_maybe rdr_name
-  = getLocalRdrEnv		`thenM` \ local_env ->
-    case lookupLocalRdrEnv local_env rdr_name of 
-	  Just name -> returnM (Just name)
-	  Nothing   -> lookupTopBndrRn_maybe rdr_name
-
 lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
 lookupLocatedTopBndrRn = wrapLocM lookupTopBndrRn
 
@@ -385,9 +368,7 @@ lookupGlobalOccRn rdr_name
                -- and only happens for failed lookups
    if isQual rdr_name && allow_qual && mod == iNTERACTIVE
       then lookupQualifiedName rdr_name
-      else do 
-        traceRn $ text "lookupGlobalOccRn"
-        unboundName rdr_name
+      else unboundName rdr_name
   }
 
 lookupImportedName :: RdrName -> TcRnIf m n Name
@@ -496,6 +477,120 @@ lookupQualifiedName rdr_name
     doc = ptext (sLit "Need to find") <+> ppr rdr_name
 \end{code}
 
+lookupSigOccRn is used for type signatures and pragmas
+Is this valid?
+  module A
+	import M( f )
+	f :: Int -> Int
+	f x = x
+It's clear that the 'f' in the signature must refer to A.f
+The Haskell98 report does not stipulate this, but it will!
+So we must treat the 'f' in the signature in the same way
+as the binding occurrence of 'f', using lookupBndrRn
+
+However, consider this case:
+	import M( f )
+	f :: Int -> Int
+	g x = x
+We don't want to say 'f' is out of scope; instead, we want to
+return the imported 'f', so that later on the reanamer will
+correctly report "misplaced type sig".
+
+\begin{code}
+lookupSigOccRn :: Maybe NameSet	   -- Just ns => source file; these are the binders
+				   -- 	 	 in the same group
+				   -- Nothing => hs-boot file; signatures without 
+				   -- 		 binders are expected
+	       -> Sig RdrName
+	       -> Located RdrName -> RnM (Located Name)
+lookupSigOccRn mb_bound_names sig
+  = wrapLocM $ \ rdr_name -> 
+    do { mb_name <- lookupBindGroupOcc mb_bound_names (hsSigDoc sig) rdr_name
+       ; case mb_name of
+	   Left err   -> do { addErr err; return (mkUnboundName rdr_name) }
+	   Right name -> return name }
+
+lookupBindGroupOcc :: Maybe NameSet  -- Just ns => source file; these are the binders
+				     -- 	 	 in the same group
+				     -- Nothing => hs-boot file; signatures without 
+				     -- 		 binders are expected
+	           -> SDoc
+	           -> RdrName -> RnM (Either Message Name)
+-- Looks up the RdrName, expecting it to resolve to one of the 
+-- bound names passed in.  If not, return an appropriate error message
+lookupBindGroupOcc mb_bound_names what rdr_name
+  = do	{ local_env <- getLocalRdrEnv
+	; case lookupLocalRdrEnv local_env rdr_name of 
+  	    Just n  -> check_local_name n
+  	    Nothing -> do	-- Not defined in a nested scope
+
+        { env <- getGlobalRdrEnv 
+  	; let gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name)
+	; case (filter isLocalGRE gres) of
+	    (gre:_) -> check_local_name (gre_name gre)
+			-- If there is more than one local GRE for the 
+			-- same OccName, that will be reported separately
+	    [] | null gres -> bale_out_with empty
+	       | otherwise -> bale_out_with import_msg
+  	}}
+    where
+      check_local_name name 	-- The name is in scope, and not imported
+  	  = case mb_bound_names of
+  		  Just bound_names | not (name `elemNameSet` bound_names)
+				   -> bale_out_with local_msg
+	 	  _other -> return (Right name)
+
+      bale_out_with msg 
+  	= return (Left (sep [ ptext (sLit "The") <+> what
+  				<+> ptext (sLit "for") <+> quotes (ppr rdr_name)
+  			   , nest 2 $ ptext (sLit "lacks an accompanying binding")]
+  		       $$ nest 2 msg))
+
+      local_msg = parens $ ptext (sLit "The")  <+> what <+> ptext (sLit "must be given where")
+  			   <+> quotes (ppr rdr_name) <+> ptext (sLit "is declared")
+
+      import_msg = parens $ ptext (sLit "You cannot give a") <+> what
+    			  <+> ptext (sLit "for an imported value")
+
+---------------
+lookupLocalDataTcNames :: NameSet -> SDoc -> RdrName -> RnM [Name]
+-- GHC extension: look up both the tycon and data con 
+-- for con-like things
+-- Complain if neither is in scope
+lookupLocalDataTcNames bound_names what rdr_name
+  | Just n <- isExact_maybe rdr_name	
+	-- Special case for (:), which doesn't get into the GlobalRdrEnv
+  = return [n]	-- For this we don't need to try the tycon too
+  | otherwise
+  = do	{ mb_gres <- mapM (lookupBindGroupOcc (Just bound_names) what)
+			  (dataTcOccs rdr_name)
+	; let (errs, names) = splitEithers mb_gres
+	; when (null names) (addErr (head errs))	-- Bleat about one only
+	; return names }
+
+dataTcOccs :: RdrName -> [RdrName]
+-- If the input is a data constructor, return both it and a type
+-- constructor.  This is useful when we aren't sure which we are
+-- looking at.
+dataTcOccs rdr_name
+  | Just n <- isExact_maybe rdr_name		-- Ghastly special case
+  , n `hasKey` consDataConKey = [rdr_name]	-- see note below
+  | isDataOcc occ 	      = [rdr_name, rdr_name_tc]
+  | otherwise 	  	      = [rdr_name]
+  where    
+    occ 	= rdrNameOcc rdr_name
+    rdr_name_tc = setRdrNameSpace rdr_name tcName
+
+-- If the user typed "[]" or "(,,)", we'll generate an Exact RdrName,
+-- and setRdrNameSpace generates an Orig, which is fine
+-- But it's not fine for (:), because there *is* no corresponding type
+-- constructor.  If we generate an Orig tycon for GHC.Base.(:), it'll
+-- appear to be in scope (because Orig's simply allocate a new name-cache
+-- entry) and then we get an error when we use dataTcOccs in 
+-- TcRnDriver.tcRnGetInfo.  Large sigh.
+\end{code}
+
+
 %*********************************************************
 %*							*
 		Fixities
@@ -602,45 +697,6 @@ lookupFixityRn name
 lookupTyFixityRn :: Located Name -> RnM Fixity
 lookupTyFixityRn (L _ n) = lookupFixityRn n
 
----------------
-lookupLocalDataTcNames :: RdrName -> RnM [Name]
--- GHC extension: look up both the tycon and data con 
--- for con-like things
--- Complain if neither is in scope
-lookupLocalDataTcNames rdr_name
-  | Just n <- isExact_maybe rdr_name	
-	-- Special case for (:), which doesn't get into the GlobalRdrEnv
-  = return [n]	-- For this we don't need to try the tycon too
-  | otherwise
-  = do	{ mb_gres <- mapM lookupGreLocalRn (dataTcOccs rdr_name)
-	; case [gre_name gre | Just gre <- mb_gres] of
-	    [] -> do { 
-                      -- run for error reporting
-                    ; unboundName rdr_name
-		      ; return [] }
-	    names -> return names
-    }
-
-dataTcOccs :: RdrName -> [RdrName]
--- If the input is a data constructor, return both it and a type
--- constructor.  This is useful when we aren't sure which we are
--- looking at.
-dataTcOccs rdr_name
-  | Just n <- isExact_maybe rdr_name		-- Ghastly special case
-  , n `hasKey` consDataConKey = [rdr_name]	-- see note below
-  | isDataOcc occ 	      = [rdr_name_tc, rdr_name]
-  | otherwise 	  	      = [rdr_name]
-  where    
-    occ 	= rdrNameOcc rdr_name
-    rdr_name_tc = setRdrNameSpace rdr_name tcName
-
--- If the user typed "[]" or "(,,)", we'll generate an Exact RdrName,
--- and setRdrNameSpace generates an Orig, which is fine
--- But it's not fine for (:), because there *is* no corresponding type
--- constructor.  If we generate an Orig tycon for GHC.Base.(:), it'll
--- appear to be in scope (because Orig's simply allocate a new name-cache
--- entry) and then we get an error when we use dataTcOccs in 
--- TcRnDriver.tcRnGetInfo.  Large sigh.
 \end{code}
 
 %************************************************************************

compiler/rename/RnExpr.lhs

@@ -1002,7 +1002,7 @@ rn_rec_stmt _ (L _ (LetStmt binds@(HsIPBinds _))) _
 rn_rec_stmt all_bndrs (L loc (LetStmt (HsValBinds binds'))) _ = do 
   (binds', du_binds) <- 
       -- fixities and unused are handled above in rn_rec_stmts_and_then
-      rnValBindsRHS all_bndrs binds'
+      rnValBindsRHS (mkNameSet all_bndrs) binds'
   returnM [(duDefs du_binds, duUses du_binds, 
 	    emptyNameSet, L loc (LetStmt (HsValBinds binds')))]
 

compiler/rename/RnSource.lhs

@@ -30,7 +30,7 @@ import RnEnv		( lookupLocalDataTcNames,
 			  bindLocalNames, checkDupRdrNames, mapFvRn,
 			)
 import RnNames       	( getLocalNonValBinders, extendGlobalRdrEnvRn )
-import HscTypes      	( GenAvailInfo(..) )
+import HscTypes      	( GenAvailInfo(..), availsToNameSet )
 import RnHsDoc          ( rnHsDoc, rnMbLHsDoc )
 import TcRnMonad
 
@@ -95,6 +95,7 @@ Checks the @(..)@ etc constraints in the export list.
 -- Brings the binders of the group into scope in the appropriate places;
 -- does NOT assume that anything is in scope already
 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
+-- Rename a HsGroup; used for normal source files *and* hs-boot files
 rnSrcDecls group@(HsGroup {hs_valds  = val_decls,
                                    hs_tyclds = tycl_decls,
                                    hs_instds = inst_decls,
@@ -113,8 +114,10 @@ rnSrcDecls group@(HsGroup {hs_valds  = val_decls,
 
    -- (B) Bring top level binders (and their fixities) into scope,
    --     *except* for the value bindings, which get brought in below.
-   avails <- getLocalNonValBinders group ;
-   tc_envs <- extendGlobalRdrEnvRn avails local_fix_env ;
+   --     However *do* include class ops, data constructors
+   --     And for hs-boot files *do* include the value signatures
+   tc_avails <- getLocalNonValBinders group ;
+   tc_envs <- extendGlobalRdrEnvRn tc_avails local_fix_env ;
    setEnvs tc_envs $ do {
 
    failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
@@ -131,10 +134,12 @@ rnSrcDecls group@(HsGroup {hs_valds  = val_decls,
    --     It uses the fixity env from (A) to bind fixities for view patterns.
    new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
    -- bind the LHSes (and their fixities) in the global rdr environment
-   let { lhs_binders = map unLoc $ collectHsValBinders new_lhs;
-         lhs_avails = map Avail lhs_binders
+   let { val_binders = map unLoc $ collectHsValBinders new_lhs ;
+	 val_bndr_set = mkNameSet val_binders ;
+	 all_bndr_set = val_bndr_set `unionNameSets` availsToNameSet tc_avails ;
+         val_avails = map Avail val_binders 
        } ;
-   (tcg_env, tcl_env) <- extendGlobalRdrEnvRn lhs_avails local_fix_env ;
+   (tcg_env, tcl_env) <- extendGlobalRdrEnvRn val_avails local_fix_env ;
    setEnvs (tcg_env, tcl_env) $ do {
 
    --  Now everything is in scope, as the remaining renaming assumes.
@@ -154,18 +159,19 @@ rnSrcDecls group@(HsGroup {hs_valds  = val_decls,
 
    -- (F) Rename Value declarations right-hand sides
    traceRn (text "Start rnmono") ;
-   (rn_val_decls, bind_dus) <- rnTopBindsRHS lhs_binders new_lhs ;
+   (rn_val_decls, bind_dus) <- rnTopBindsRHS val_bndr_set new_lhs ;
    traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
 
    -- (G) Rename Fixity and deprecations
    
-   -- rename fixity declarations and error if we try to
+   -- Rename fixity declarations and error if we try to
    -- fix something from another module (duplicates were checked in (A))
-   rn_fix_decls                 <- rnSrcFixityDecls fix_decls ;
-   -- rename deprec decls;
+   rn_fix_decls <- rnSrcFixityDecls all_bndr_set fix_decls ;
+
+   -- Rename deprec decls;
    -- check for duplicates and ensure that deprecated things are defined locally
    -- at the moment, we don't keep these around past renaming
-   rn_warns <- rnSrcWarnDecls warn_decls ;
+   rn_warns <- rnSrcWarnDecls all_bndr_set warn_decls ;
 
    -- (H) Rename Everything else
 
@@ -259,14 +265,14 @@ rnDocDecl (DocGroup lev doc) = do
 %*********************************************************
 
 \begin{code}
-rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
+rnSrcFixityDecls :: NameSet -> [LFixitySig RdrName] -> RnM [LFixitySig Name]
 -- Rename the fixity decls, so we can put
 -- the renamed decls in the renamed syntax tree
 -- Errors if the thing being fixed is not defined locally.
 --
 -- The returned FixitySigs are not actually used for anything,
 -- except perhaps the GHCi API
-rnSrcFixityDecls fix_decls
+rnSrcFixityDecls bound_names fix_decls
   = do fix_decls <- mapM rn_decl fix_decls
        return (concat fix_decls)
   where
@@ -278,9 +284,10 @@ rnSrcFixityDecls fix_decls
     rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
       = setSrcSpan name_loc $
                     -- this lookup will fail if the definition isn't local
-        do names <- lookupLocalDataTcNames rdr_name
+        do names <- lookupLocalDataTcNames bound_names what rdr_name
            return [ L loc (FixitySig (L name_loc name) fixity)
-                    | name <- names ]
+                  | name <- names ]
+    what = ptext (sLit "fixity signature")
 \end{code}
 
 
@@ -298,11 +305,11 @@ gather them together.
 
 \begin{code}
 -- checks that the deprecations are defined locally, and that there are no duplicates
-rnSrcWarnDecls :: [LWarnDecl RdrName] -> RnM Warnings
-rnSrcWarnDecls [] 
+rnSrcWarnDecls :: NameSet -> [LWarnDecl RdrName] -> RnM Warnings
+rnSrcWarnDecls _bound_names [] 
   = returnM NoWarnings
 
-rnSrcWarnDecls decls 
+rnSrcWarnDecls bound_names decls 
   = do { -- check for duplicates
        ; mappM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupWarnDecl lrdr')) warn_rdr_dups
        ; mappM (addLocM rn_deprec) decls	`thenM` \ pairs_s ->
@@ -310,9 +317,11 @@ rnSrcWarnDecls decls
  where
    rn_deprec (Warning rdr_name txt)
        -- ensures that the names are defined locally
-     = lookupLocalDataTcNames rdr_name	`thenM` \ names ->
+     = lookupLocalDataTcNames bound_names what rdr_name	`thenM` \ names ->
        returnM [(nameOccName name, txt) | name <- names]
    
+   what = ptext (sLit "deprecation")
+
    -- look for duplicates among the OccNames;
    -- we check that the names are defined above
    -- invt: the lists returned by findDupsEq always have at least two elements

compiler/typecheck/TcDeriv.lhs

@@ -323,10 +323,10 @@ renameDeriv is_boot gen_binds insts
 	; let aux_binds = listToBag $ map (genAuxBind loc) $ 
 			  rm_dups [] $ concat deriv_aux_binds
 	; rn_aux_lhs <- rnTopBindsLHS emptyFsEnv (ValBindsIn aux_binds [])
-	; let aux_names =  map unLoc (collectHsValBinders rn_aux_lhs)
+	; let aux_names = map unLoc (collectHsValBinders rn_aux_lhs)
 
 	; bindLocalNames aux_names $ 
-    do	{ (rn_aux, _dus) <- rnTopBindsRHS aux_names rn_aux_lhs
+    do	{ (rn_aux, _dus) <- rnTopBindsRHS (mkNameSet aux_names) rn_aux_lhs
 	; rn_inst_infos <- mapM rn_inst_info inst_infos
 	; return (rn_inst_infos, rn_aux `plusHsValBinds` rn_gen) } }