A batch of changes related to the handling of binders in instance decls

The issue is that in
    instnace C T where
      data S = ...
      f = ...
neither S nor f is really a binder; they are *occurrences*.  Moreover
Haskell dictates that these particular occurrences are disambiguated
by looking at the class whose instance they occur in.

Some of this was not handled right for associated types.  And
RnNames.getLocalNonValBinders was a bit messhy; this patch tidies it
up.

(And thenM is finally gone from RnSource.)

4 files changed, 223 insertions, 219 deletions

diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index a833c83b01..36fcfdbe09 100644
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -624,7 +624,7 @@ rnMethodBind cls sig_fn
              (L loc bind@(FunBind { fun_id = name, fun_infix = is_infix 
 				  , fun_matches = MatchGroup matches _ }))
   = setSrcSpan loc $ do
-    sel_name <- wrapLocM (lookupInstDeclBndr cls) name
+    sel_name <- wrapLocM (lookupInstDeclBndr cls (ptext (sLit "method"))) name
     let plain_name = unLoc sel_name
         -- We use the selector name as the binder
 
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 09890181a5..7d4c2b6527 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -236,7 +236,7 @@ lookupExactOcc name
            _     -> pprPanic "lookupExactOcc" (ppr name $$ ppr gres) }
 
 -----------------------------------------------
-lookupInstDeclBndr :: Name -> RdrName -> RnM Name
+lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name
 -- This is called on the method name on the left-hand side of an 
 -- instance declaration binding. eg.  instance Functor T where
 --                                       fmap = ...
@@ -248,7 +248,10 @@ lookupInstDeclBndr :: Name -> RdrName -> RnM Name
 -- name is only in scope qualified.  I.e. even if method op is
 -- in scope as M.op, we still allow plain 'op' on the LHS of
 -- an instance decl
-lookupInstDeclBndr cls rdr
+--
+-- The "what" parameter says "method" or "associated type",
+-- depending on what we are looking up
+lookupInstDeclBndr cls what rdr
   = do { when (isQual rdr)
        	      (addErr (badQualBndrErr rdr)) 
 	       	-- In an instance decl you aren't allowed
@@ -256,7 +259,7 @@ lookupInstDeclBndr cls rdr
 		-- (Although it'd make perfect sense.)
        ; lookupSubBndr (ParentIs cls) doc rdr }
   where
-    doc = ptext (sLit "method of class") <+> quotes (ppr cls)
+    doc = what <+> ptext (sLit "of class") <+> quotes (ppr cls)
 
 -----------------------------------------------
 lookupConstructorFields :: Name -> RnM [Name]
@@ -443,7 +446,8 @@ lookupOccRn rdr_name
                -- and only happens for failed lookups
        ; if isQual rdr_name && allow_qual && is_ghci
          then lookupQualifiedName rdr_name
-         else unboundName WL_Any rdr_name } } } } }
+         else do { traceRn (text "lookupOccRn" <+> ppr rdr_name)
+                 ; unboundName WL_Any rdr_name } } } } } }
 
 
 lookupGlobalOccRn :: RdrName -> RnM Name
@@ -453,7 +457,8 @@ lookupGlobalOccRn rdr_name
   = do { mb_name <- lookupGlobalOccRn_maybe rdr_name
        ; case mb_name of
            Just n  -> return n
-           Nothing -> unboundName WL_Global rdr_name }
+           Nothing -> do { traceRn (text "lookupGlobalOccRn" <+> ppr rdr_name)
+                         ; unboundName WL_Global rdr_name } }
 
 lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name)
 -- No filter function; does not report an error on failure
@@ -489,7 +494,8 @@ lookupGreRn rdr_name
 	; case mb_gre of {
 	    Just gre -> return gre ;
 	    Nothing  -> do
-	{ name <- unboundName WL_Global rdr_name
+	{ traceRn (text "lookupGreRn" <+> ppr rdr_name)
+        ; name <- unboundName WL_Global rdr_name
 	; return (GRE { gre_name = name, gre_par = NoParent,
 		        gre_prov = LocalDef }) }}}
 
@@ -549,7 +555,8 @@ lookupQualifiedName rdr_name
     	   name  <- availNames avail,
     	   nameOccName name == occ ] of
       (n:ns) -> ASSERT (null ns) return n
-      _ -> unboundName WL_Any rdr_name
+      _ -> do { traceRn (text "lookupQualified" <+> ppr rdr_name)
+              ; unboundName WL_Any rdr_name }
 
   | otherwise
   = pprPanic "RnEnv.lookupQualifiedName" (ppr rdr_name)
@@ -644,14 +651,14 @@ lookupBindGroupOcc mb_bound_names what rdr_name
 ---------------
 lookupLocalDataTcNames :: NameSet -> SDoc -> RdrName -> RnM [Name]
 -- GHC extension: look up both the tycon and data con 
--- for con-like things
+-- for con-like things.  Used for top-level fixity signatures
 -- Complain if neither is in scope
-lookupLocalDataTcNames bound_names what rdr_name
+lookupLocalDataTcNames bndr_set what rdr_name
   | Just n <- isExact_maybe rdr_name	
 	-- Special case for (:), which doesn't get into the GlobalRdrEnv
   = do { n' <- lookupExactOcc n; return [n'] }	-- For this we don't need to try the tycon too
   | otherwise
-  = do	{ mb_gres <- mapM (lookupBindGroupOcc (Just bound_names) what)
+  = do	{ mb_gres <- mapM (lookupBindGroupOcc (Just bndr_set) what)
 			  (dataTcOccs rdr_name)
 	; let (errs, names) = splitEithers mb_gres
 	; when (null names) (addErr (head errs))	-- Bleat about one only
diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 5b603cf6f9..dc8b46c0a9 100644
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -7,7 +7,7 @@
 module RnNames (
         rnImports, getLocalNonValBinders,
         rnExports, extendGlobalRdrEnvRn,
-        gresFromAvails,
+        gresFromAvails, lookupTcdName,
         reportUnusedNames, finishWarnings,
     ) where
 
@@ -469,53 +469,9 @@ used for source code.
 
         *** See "THE NAMING STORY" in HsDecls ****
 
-Instances of type families
-~~~~~~~~~~~~~~~~~~~~~~~~~~
-Family instances contain data constructors that we need to collect and we also
-need to descend into the type instances of associated families in class
-instances. The type constructor of a family instance is a usage occurence.
-Hence, we don't return it as a subname in 'AvailInfo'; otherwise, we would get
-a duplicate declaration error.
-
-Note [Looking up family names in family instances]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider
-
-  module M where
-    type family T a :: *
-    type instance M.T Int = Bool
-
-We might think that we can simply use 'lookupOccRn' when processing the type
-instance to look up 'M.T'.  Alas, we can't!  The type family declaration is in
-the *same* HsGroup as the type instance declaration.  Hence, as we are
-currently collecting the binders declared in that HsGroup, these binders will
-not have been added to the global environment yet.
-
-In the case of type classes, this problem does not arise, as a class instance
-does not define any binders of its own.  So, we simply don't attempt to look
-up the class names of class instances in 'get_local_binders' below.
-
-If we don't look up class instances, can't we get away without looking up type
-instances, too?  No, we can't.  Data type instances define data constructors
-and we need to
-
-  (1) collect those in 'get_local_binders' and
-  (2) we need to get their parent name in 'get_local_binders', too, to
-      produce an appropriate 'AvailTC'.
-
-This parent name is exactly the family name of the type instance that is so
-difficult to look up.
-
-We solve this problem as follows:
-
-  (a) We process all type declarations *other* than type instances first.
-  (b) Then, we compute an 'OccEnv' from the result of the first step.
-  (c) Finally, we process all type instances (both those on the toplevel and
-      those nested in class instances) and check for the family names in the
-      'GlobalRdrEnv' produced in the previous step before using 'lookupOccRn'.
-
 \begin{code}
-getLocalNonValBinders :: HsGroup RdrName -> RnM [AvailInfo]
+getLocalNonValBinders :: MiniFixityEnv -> HsGroup RdrName 
+                      -> RnM ((TcGblEnv, TcLclEnv), NameSet)
 -- Get all the top-level binders bound the group *except*
 -- for value bindings, which are treated separately
 -- Specificaly we return AvailInfo for
@@ -525,52 +481,48 @@ getLocalNonValBinders :: HsGroup RdrName -> RnM [AvailInfo]
 --      foreign imports
 --      (in hs-boot files) value signatures
 
-getLocalNonValBinders group
-  = do { gbl_env <- getGblEnv
-       ; get_local_binders gbl_env group }
-
-get_local_binders :: TcGblEnv -> HsGroup RdrName -> RnM [AvailInfo]
-get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
-                                    hs_tyclds = tycl_decls,
-                                    hs_instds = inst_decls,
-                                    hs_fords  = foreign_decls })
-  = do  { -- separate out the family instance declarations
-          let (tyinst_decls1, tycl_decls_noinsts)
-                           = partition (isFamInstDecl . unLoc) (concat tycl_decls)
-              tyinst_decls = tyinst_decls1 ++ instDeclATs inst_decls
-
-          -- process all type/class decls except family instances
-        ; tc_avails  <- mapM new_tc tycl_decls_noinsts
-
-          -- Create a temporary env of the type binders
-	  -- See Note [Looking up family names in family instances]
-	  -- NB: associated types may be a sub-bndr of a class
-	  -- 		AvailTC C [C,T,op]
-	  -- Hence availNames, not availName
-        ; let local_tc_env :: OccEnv Name
-              local_tc_env = mkOccEnv [ (occ, n) 
-                                      | a <- tc_avails
-                                      , n <- availNames a
-				      , let occ = nameOccName n
-                                      , isTcOcc occ  ]
+getLocalNonValBinders fixity_env 
+     (HsGroup { hs_valds  = val_binds,
+                hs_tyclds = tycl_decls,
+                hs_instds = inst_decls,
+                hs_fords  = foreign_decls })
+  = do  { -- Separate out the family instance declarations
+          let (tyinst_decls, tycl_decls_noinsts)
+                   = partition (isFamInstDecl . unLoc) (concat tycl_decls)
+
+          -- Process all type/class decls *except* family instances
+        ; tc_avails <- mapM new_tc tycl_decls_noinsts
+        ; envs <- extendGlobalRdrEnvRn tc_avails fixity_env
+	; setEnvs envs $ do {
+	    -- Bring these things into scope first
+            -- See Note [Looking up family names in family instances]
 
           -- Process all family instances
-        ; ti_avails <- mapM (new_ti local_tc_env) tyinst_decls
-
-          -- finish off with value binder in case of a hs-boot file
+	  -- to bring new data constructors into scope
+        ; ti_avails  <- mapM (new_ti Nothing) tyinst_decls
+        ; nti_avails <- concatMapM new_assoc inst_decls
+
+          -- Finish off with value binders:
+	  --    foreign decls for an ordinary module
+	  --    type sigs in case of a hs-boot file only
+        ; is_boot <- tcIsHsBoot 
+        ; let val_bndrs | is_boot   = hs_boot_sig_bndrs
+                        | otherwise = for_hs_bndrs
         ; val_avails <- mapM new_simple val_bndrs
-        ; return (val_avails ++ tc_avails ++ ti_avails) }
-  where
-    is_hs_boot = isHsBoot (tcg_src gbl_env) ;
 
+	; let avails    = ti_avails ++ nti_avails ++ val_avails
+	      new_bndrs = availsToNameSet avails `unionNameSets` 
+                          availsToNameSet tc_avails
+        ; envs <- extendGlobalRdrEnvRn avails fixity_env 
+        ; return (envs, new_bndrs) } }
+  where
     for_hs_bndrs :: [Located RdrName]
     for_hs_bndrs = [nm | L _ (ForeignImport nm _ _) <- foreign_decls]
 
     -- In a hs-boot file, the value binders come from the
     --  *signatures*, and there should be no foreign binders
-    val_bndrs :: [Located RdrName]
-    val_bndrs | is_hs_boot = [n | L _ (TypeSig ns _) <- val_sigs, n <- ns]
-              | otherwise  = for_hs_bndrs
+    hs_boot_sig_bndrs = [n | L _ (TypeSig ns _) <- val_sigs, n <- ns]
+    ValBindsIn _ val_sigs = val_binds
 
     new_simple :: Located RdrName -> RnM AvailInfo
     new_simple rdr_name = do{ nm <- newTopSrcBinder rdr_name
@@ -580,21 +532,89 @@ get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
         = do { names@(main_name : _) <- mapM newTopSrcBinder (hsTyClDeclBinders tc_decl)
              ; return (AvailTC main_name names) }
 
-    new_ti local_tc_env ti_decl  -- ONLY for type/data instances
-        = do { let L loc tc_rdr = tcdLName (unLoc ti_decl)
-             ; main_name <- setSrcSpan loc $
-                            case lookupOccEnv local_tc_env (rdrNameOcc tc_rdr) of
-                              Nothing -> lookupGlobalOccRn tc_rdr
-                              Just n  -> return n
-		    -- See Note [Looking up family names in family instances]
-
+    new_ti :: Maybe Name -> LTyClDecl RdrName -> RnM AvailInfo
+    new_ti mb_cls ti_decl  -- ONLY for type/data instances
+        = do { main_name <- lookupTcdName mb_cls (unLoc ti_decl)
              ; sub_names <- mapM newTopSrcBinder (hsTyClDeclBinders ti_decl)
-             ; return (AvailTC main_name sub_names) }
+             ; return (AvailTC (unLoc main_name) sub_names) }
                         -- main_name is not bound here!
 
-get_local_binders _ g = pprPanic "get_local_binders" (ppr g)
+    new_assoc :: LInstDecl RdrName -> RnM [AvailInfo]
+    new_assoc (L _ (InstDecl inst_ty _ _ ats))
+      = do { cls_nm <- setSrcSpan loc $ lookupGlobalOccRn cls_rdr
+           ; mapM (new_ti (Just cls_nm)) ats }
+      where
+        (_, _, L loc cls_rdr, _) = splitHsInstDeclTy inst_ty
+
+lookupTcdName :: Maybe Name -> TyClDecl RdrName -> RnM (Located Name)
+-- Used for TyData and TySynonym only
+-- See Note [Family instance binders]
+lookupTcdName mb_cls tc_decl
+  | not (isFamInstDecl tc_decl)	  -- The normal case
+  = ASSERT2( isNothing mb_cls, ppr tc_rdr )	-- Parser prevents this
+    lookupLocatedTopBndrRn tc_rdr
+
+  | Just cls <- mb_cls	    -- Associated type; c.f RnBinds.rnMethodBind
+  = wrapLocM (lookupInstDeclBndr cls (ptext (sLit "associated type"))) tc_rdr
+
+  | otherwise		    -- Family instance; tc_rdr is an *occurrence*
+  = lookupLocatedOccRn tc_rdr 
+  where
+    tc_rdr = tcdLName tc_decl
 \end{code}
 
+Note [Looking up family names in family instances]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+
+  module M where
+    type family T a :: *
+    type instance M.T Int = Bool
+
+We might think that we can simply use 'lookupOccRn' when processing the type
+instance to look up 'M.T'.  Alas, we can't!  The type family declaration is in
+the *same* HsGroup as the type instance declaration.  Hence, as we are
+currently collecting the binders declared in that HsGroup, these binders will
+not have been added to the global environment yet.
+
+Solution is simple: process the type family declarations first, extend
+the environment, and then process the type instances.
+
+
+Note [Family instance binders]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+  data family F a
+  data instance F T = X1 | X2
+
+The 'data instance' decl has an *occurrence* of F (and T), and *binds*
+X1 and X2.  (This is unlike a normal data type declaration which would
+bind F too.)  So we want an AvailTC F [X1,X2].
+
+Now consider a similar pair:
+  class C a where
+    data G a
+  instance C S where
+    data G S = Y1 | Y2
+
+The 'data G S' *binds* Y1 and Y2, and has an *occurrence* of G.
+
+But there is a small complication: in an instance decl, we don't use
+qualified names on the LHS; instead we use the class to disambiguate.
+Thus:
+  module M where
+    import Blib( G )
+    class C a where
+      data G a
+    instance C S where
+      data G S = Y1 | Y2
+Even though there are two G's in scope (M.G and Blib.G), the occurence
+of 'G' in the 'instance C S' decl is unambiguous, becuase C has only
+one associated type called G. This is exactly what happens for methods,
+and it is only consistent to do the same thing for types. That's the
+role of the function lookupTcdName; the (Maybe Name) give the class of
+the encloseing instance decl, if any.
+
 
 %************************************************************************
 %*                                                                      *
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 64feaed8e4..b21b24e5f6 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -20,17 +20,11 @@ import RdrName		( RdrName, isRdrDataCon, elemLocalRdrEnv, rdrNameOcc )
 import RdrHsSyn		( extractHsRhoRdrTyVars )
 import RnHsSyn
 import RnTypes
-import RnBinds		( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, renameSigs, mkSigTvFn,
-                                makeMiniFixityEnv)
-import RnEnv		( lookupLocalDataTcNames, lookupLocatedOccRn,
-			  lookupTopBndrRn, lookupLocatedTopBndrRn,
-			  lookupOccRn, bindLocalNamesFV,
-			  bindLocatedLocalsFV, bindPatSigTyVarsFV,
-			  bindTyVarsRn, bindTyVarsFV, extendTyVarEnvFVRn,
-			  bindLocalNames, checkDupRdrNames, mapFvRn
-			)
-import RnNames       	( getLocalNonValBinders, extendGlobalRdrEnvRn )
-import HscTypes      	( AvailInfo(..), availsToNameSet )
+import RnBinds		( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, 
+                          renameSigs, mkSigTvFn, makeMiniFixityEnv )
+import RnEnv
+import RnNames       	( getLocalNonValBinders, extendGlobalRdrEnvRn, lookupTcdName )
+import HscTypes      	( AvailInfo(..) )
 import RnHsDoc          ( rnHsDoc, rnMbLHsDoc )
 import TcRnMonad
 
@@ -57,15 +51,6 @@ import Maybes( orElse )
 import Data.Maybe
 \end{code}
 
-\begin{code}
--- XXX
-thenM :: Monad a => a b -> (b -> a c) -> a c
-thenM = (>>=)
-
-thenM_ :: Monad a => a b -> a c -> a c
-thenM_ = (>>)
-\end{code}
-
 @rnSourceDecl@ `renames' declarations.
 It simultaneously performs dependency analysis and precedence parsing.
 It also does the following error checks:
@@ -103,14 +88,13 @@ rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
    -- (A) Process the fixity declarations, creating a mapping from
    --     FastStrings to FixItems.
    --     Also checks for duplcates.
-   local_fix_env <- makeMiniFixityEnv fix_decls;
+   local_fix_env <- makeMiniFixityEnv fix_decls ;
 
    -- (B) Bring top level binders (and their fixities) into scope,
    --     *except* for the value bindings, which get brought in below.
    --     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 ;
+   (tc_envs, tc_bndrs) <- getLocalNonValBinders local_fix_env group ;
    setEnvs tc_envs $ do {
 
    failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
@@ -127,11 +111,9 @@ 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 { val_binders = 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 
-       } ;
+   let { val_binders  = collectHsValBinders new_lhs ;
+         all_bndr_set = addListToNameSet tc_bndrs val_binders ;
+         val_avails   = map Avail val_binders  } ;
    (tcg_env, tcl_env) <- extendGlobalRdrEnvRn val_avails local_fix_env ;
    traceRn (ptext (sLit "Val binders") <+> (ppr val_binders)) ;
    setEnvs (tcg_env, tcl_env) $ do {
@@ -270,7 +252,7 @@ rnSrcFixityDecls :: NameSet -> [LFixitySig RdrName] -> RnM [LFixitySig Name]
 --
 -- The returned FixitySigs are not actually used for anything,
 -- except perhaps the GHCi API
-rnSrcFixityDecls bound_names fix_decls
+rnSrcFixityDecls bndr_set fix_decls
   = do fix_decls <- mapM rn_decl fix_decls
        return (concat fix_decls)
   where
@@ -282,7 +264,7 @@ rnSrcFixityDecls bound_names 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 bound_names what rdr_name
+        do names <- lookupLocalDataTcNames bndr_set what rdr_name
            return [ L loc (FixitySig (L name_loc name) fixity)
                   | name <- names ]
     what = ptext (sLit "fixity signature")
@@ -304,10 +286,10 @@ gather them together.
 \begin{code}
 -- checks that the deprecations are defined locally, and that there are no duplicates
 rnSrcWarnDecls :: NameSet -> [LWarnDecl RdrName] -> RnM Warnings
-rnSrcWarnDecls _bound_names [] 
+rnSrcWarnDecls _ [] 
   = return NoWarnings
 
-rnSrcWarnDecls bound_names decls 
+rnSrcWarnDecls bndr_set decls 
   = do { -- check for duplicates
        ; mapM_ (\ dups -> let (L loc rdr:lrdr':_) = dups
                           in addErrAt loc (dupWarnDecl lrdr' rdr)) 
@@ -317,8 +299,8 @@ rnSrcWarnDecls bound_names decls
  where
    rn_deprec (Warning rdr_name txt)
        -- ensures that the names are defined locally
-     = lookupLocalDataTcNames bound_names what rdr_name	`thenM` \ names ->
-       return [(nameOccName name, txt) | name <- names]
+     = do { names <- lookupLocalDataTcNames bndr_set what rdr_name
+          ; return [(nameOccName name, txt) | name <- names] }
    
    what = ptext (sLit "deprecation")
 
@@ -364,8 +346,8 @@ rnAnnProvenance provenance = do
 \begin{code}
 rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
 rnDefaultDecl (DefaultDecl tys)
-  = mapFvRn (rnHsTypeFVs doc_str) tys	`thenM` \ (tys', fvs) ->
-    return (DefaultDecl tys', fvs)
+  = do { (tys', fvs) <- mapFvRn (rnHsTypeFVs doc_str) tys
+       ; return (DefaultDecl tys', fvs) }
   where
     doc_str = text "In a `default' declaration"
 \end{code}
@@ -379,20 +361,20 @@ rnDefaultDecl (DefaultDecl tys)
 \begin{code}
 rnHsForeignDecl :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
 rnHsForeignDecl (ForeignImport name ty spec)
-  = getTopEnv                           `thenM` \ (topEnv :: HscEnv) ->
-    lookupLocatedTopBndrRn name	        `thenM` \ name' ->
-    rnHsTypeFVs (fo_decl_msg name) ty	`thenM` \ (ty', fvs) ->
+  = do { topEnv :: HscEnv <- getTopEnv
+       ; name' <- lookupLocatedTopBndrRn name
+       ; (ty', fvs) <- rnHsTypeFVs (fo_decl_msg name) ty
 
-    -- Mark any PackageTarget style imports as coming from the current package
-    let packageId	= thisPackage $ hsc_dflags topEnv
-	spec'		= patchForeignImport packageId spec
+        -- Mark any PackageTarget style imports as coming from the current package
+       ; let packageId = thisPackage $ hsc_dflags topEnv
+	     spec'     = patchForeignImport packageId spec
 
-    in	return (ForeignImport name' ty' spec', fvs)
+       ; return (ForeignImport name' ty' spec', fvs) }
 
 rnHsForeignDecl (ForeignExport name ty spec)
-  = lookupLocatedOccRn name	        `thenM` \ name' ->
-    rnHsTypeFVs (fo_decl_msg name) ty  	`thenM` \ (ty', fvs) ->
-    return (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
+  = do { name' <- lookupLocatedOccRn name
+       ; (ty', fvs) <- rnHsTypeFVs (fo_decl_msg name) ty
+       ; return (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name') }
 	-- NB: a foreign export is an *occurrence site* for name, so 
 	--     we add it to the free-variable list.  It might, for example,
 	--     be imported from another module
@@ -438,30 +420,28 @@ patchCCallTarget packageId callTarget
 rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
 	-- Used for both source and interface file decls
-  = rnHsSigType (text "an instance decl") inst_ty	`thenM` \ inst_ty' ->
+  = do { inst_ty' <- rnHsSigType (text "an instance decl") inst_ty
 
 	-- Rename the bindings
 	-- The typechecker (not the renamer) checks that all 
 	-- the bindings are for the right class
-    let
-	(inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
-    in
-    extendTyVarEnvForMethodBinds inst_tyvars (		
-	-- (Slightly strangely) the forall-d tyvars scope over
-	-- the method bindings too
-	rnMethodBinds cls (\_ -> []) 	-- No scoped tyvars
-		      mbinds
-    )						`thenM` \ (mbinds', meth_fvs) ->
+       ; let (inst_tyvars, _, L _ cls, _) = splitHsInstDeclTy inst_ty'
+
+       ; (mbinds', meth_fvs) <- extendTyVarEnvForMethodBinds inst_tyvars $
+				rnMethodBinds cls (\_ -> []) 	-- No scoped tyvars
+					      mbinds    
+	     -- (Slightly strangely) the forall-d tyvars 
+             -- scope over the method bindings too
+
 	-- Rename the associated types
 	-- The typechecker (not the renamer) checks that all 
 	-- the declarations are for the right class
-    let
-	at_names = map (tcdLName . unLoc) ats	-- The names of the associated types
-    in
-    checkDupRdrNames at_names		`thenM_`
+       ; let  at_names = map (tcdLName . unLoc) ats	-- The names of the associated types
+       ; checkDupRdrNames at_names
 	-- See notes with checkDupRdrNames for methods, above
 
-    rnATInsts ats				`thenM` \ (ats', at_fvs) ->
+       ; traceRn (text "rnATInsts" <+> ppr ats)
+       ; (ats', at_fvs) <- rnATInsts cls ats
 
 	-- Rename the prags and signatures.
 	-- Note that the type variables are not in scope here,
@@ -470,17 +450,15 @@ rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
 	-- works OK. 
 	--
 	-- But the (unqualified) method names are in scope
-    let 
-	binders = collectHsBindsBinders mbinds'
-	bndr_set = mkNameSet binders
-    in
-    bindLocalNames binders 
-	(renameSigs (Just bndr_set) okInstDclSig uprags)	`thenM` \ uprags' ->
-
-    return (InstDecl inst_ty' mbinds' uprags' ats',
-	     meth_fvs `plusFV` at_fvs
-		      `plusFV` hsSigsFVs uprags'
-		      `plusFV` extractHsTyNames inst_ty')
+       ; let binders = collectHsBindsBinders mbinds'
+	     bndr_set = mkNameSet binders
+       ; uprags' <- bindLocalNames binders $
+	            renameSigs (Just bndr_set) okInstDclSig uprags
+
+       ; return (InstDecl inst_ty' mbinds' uprags' ats',
+	         meth_fvs `plusFV` at_fvs
+		      	  `plusFV` hsSigsFVs uprags'
+		      	  `plusFV` extractHsTyNames inst_ty') }
              -- We return the renamed associated data type declarations so
              -- that they can be entered into the list of type declarations
              -- for the binding group, but we also keep a copy in the instance.
@@ -496,14 +474,13 @@ rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
 Renaming of the associated types in instances.  
 
 \begin{code}
-rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
-rnATInsts atDecls = rnList rnATInst atDecls
+rnATInsts :: Name -> [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
+rnATInsts cls atDecls = rnList rnATInst atDecls
   where
-    rnATInst tydecl@TyData     {} = rnTyClDecl tydecl
-    rnATInst tydecl@TySynonym  {} = rnTyClDecl tydecl
-    rnATInst tydecl               =
-      pprPanic "RnSource.rnATInsts: invalid AT instance" 
-	       (ppr (tcdName tydecl))
+    rnATInst tydecl@TyData     {} = rnTyClDecl (Just cls) tydecl
+    rnATInst tydecl@TySynonym  {} = rnTyClDecl (Just cls) tydecl
+    rnATInst tydecl               = pprPanic "RnSource.rnATInsts: invalid AT instance" 
+                                             (ppr (tcdName tydecl))
 \end{code}
 
 For the method bindings in class and instance decls, we extend the 
@@ -573,8 +550,8 @@ rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
     rn_var (RuleBndr (L loc _), id)
 	= return (RuleBndr (L loc id), emptyFVs)
     rn_var (RuleBndrSig (L loc _) t, id)
-	= rnHsTypeFVs doc t	`thenM` \ (t', fvs) ->
-	  return (RuleBndrSig (L loc id) t', fvs)
+	= do { (t', fvs) <- rnHsTypeFVs doc t
+	     ; return (RuleBndrSig (L loc id) t', fvs) }
 
 badRuleVar :: FastString -> Name -> SDoc
 badRuleVar name var
@@ -709,7 +686,7 @@ However, we can also do some scoping checks at the same time.
 rnTyClDecls :: [[LTyClDecl RdrName]] -> RnM ([[LTyClDecl Name]], FreeVars)
 -- Renamed the declarations and do depedency analysis on them
 rnTyClDecls tycl_ds
-  = do { ds_w_fvs <- mapM (wrapLocFstM rnTyClDecl) (concat tycl_ds)
+  = do { ds_w_fvs <- mapM (wrapLocFstM (rnTyClDecl Nothing)) (concat tycl_ds)
 
        ; let sccs :: [SCC (LTyClDecl Name)]
              sccs = depAnalTyClDecls ds_w_fvs
@@ -718,24 +695,26 @@ rnTyClDecls tycl_ds
 
        ; return (map flattenSCC sccs, all_fvs) }
 
-rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
-rnTyClDecl (ForeignType {tcdLName = name, tcdExtName = ext_name})
-  = lookupLocatedTopBndrRn name		`thenM` \ name' ->
-    return (ForeignType {tcdLName = name', tcdExtName = ext_name},
-	     emptyFVs)
+rnTyClDecl :: Maybe Name  -- Just cls => this TyClDecl is nested 
+	      	    	  --             inside an *instance decl* for cls
+			  --             used for associated types
+           -> TyClDecl RdrName 
+           -> RnM (TyClDecl Name, FreeVars)
+rnTyClDecl _ (ForeignType {tcdLName = name, tcdExtName = ext_name})
+  = do { name' <- lookupLocatedTopBndrRn name
+       ; return (ForeignType {tcdLName = name', tcdExtName = ext_name},
+	         emptyFVs) }
 
 -- all flavours of type family declarations ("type family", "newtype family",
 -- and "data family")
-rnTyClDecl tydecl@TyFamily {} = rnFamily tydecl bindTyVarsFV
+rnTyClDecl _ tydecl@TyFamily {} = rnFamily tydecl bindTyVarsFV
 
 -- "data", "newtype", "data instance, and "newtype instance" declarations
-rnTyClDecl tydecl@TyData {tcdND = new_or_data, tcdCtxt = context, 
-			   tcdLName = tycon, tcdTyVars = tyvars, 
-			   tcdTyPats = typats, tcdCons = condecls, 
-			   tcdKindSig = sig, tcdDerivs = derivs}
-  = do	{ tycon' <- if isFamInstDecl tydecl
-		    then lookupLocatedOccRn     tycon -- may be imported family
-		    else lookupLocatedTopBndrRn tycon
+rnTyClDecl mb_cls tydecl@TyData {tcdND = new_or_data, tcdCtxt = context, 
+			   	 tcdLName = tycon, tcdTyVars = tyvars, 
+			   	 tcdTyPats = typats, tcdCons = condecls, 
+			   	 tcdKindSig = sig, tcdDerivs = derivs}
+  = do	{ tycon' <- lookupTcdName mb_cls tydecl
 	; checkTc (h98_style || null (unLoc context)) 
                   (badGadtStupidTheta tycon)
     	; ((tyvars', context', typats', derivs'), stuff_fvs)
@@ -774,17 +753,15 @@ rnTyClDecl tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
 
     rn_derivs Nothing   = return (Nothing, emptyFVs)
-    rn_derivs (Just ds) = rnLHsTypes data_doc ds	`thenM` \ ds' -> 
-			  return (Just ds', extractHsTyNames_s ds')
+    rn_derivs (Just ds) = do { ds' <- rnLHsTypes data_doc ds
+			     ; return (Just ds', extractHsTyNames_s ds') }
 
 -- "type" and "type instance" declarations
-rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
-			      tcdTyPats = typats, tcdSynRhs = ty})
+rnTyClDecl mb_cls tydecl@(TySynonym { tcdTyVars = tyvars, tcdLName = name,
+		  	              tcdTyPats = typats, tcdSynRhs = ty})
   = bindTyVarsFV tyvars $ \ tyvars' -> do
     {    	 -- Checks for distinct tyvars
-      name' <- if isFamInstDecl tydecl
-    		  then lookupLocatedOccRn     name -- may be imported family
-    		  else lookupLocatedTopBndrRn name
+      name' <- lookupTcdName mb_cls tydecl
     ; (typats',fvs1) <- rnTyPats syn_doc name' typats
     ; (ty', fvs2)    <- rnHsTypeFVs syn_doc ty
     ; return (TySynonym { tcdLName = name', tcdTyVars = tyvars' 
@@ -793,9 +770,9 @@ rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
   where
     syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
 
-rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname, 
-		       tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs, 
-		       tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
+rnTyClDecl _ (ClassDecl {tcdCtxt = context, tcdLName = cname, 
+		         tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs, 
+		         tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
   = do	{ cname' <- lookupLocatedTopBndrRn cname
 
 	-- Tyvars scope over superclass context and method signatures
@@ -983,13 +960,13 @@ rnConDeclDetails :: SDoc
                  -> HsConDetails (LHsType RdrName) [ConDeclField RdrName]
                  -> RnM (HsConDetails (LHsType Name) [ConDeclField Name])
 rnConDeclDetails doc (PrefixCon tys)
-  = mapM (rnLHsType doc) tys	`thenM` \ new_tys  ->
-    return (PrefixCon new_tys)
+  = do { new_tys <- mapM (rnLHsType doc) tys
+       ; return (PrefixCon new_tys) }
 
 rnConDeclDetails doc (InfixCon ty1 ty2)
-  = rnLHsType doc ty1  		`thenM` \ new_ty1 ->
-    rnLHsType doc ty2  		`thenM` \ new_ty2 ->
-    return (InfixCon new_ty1 new_ty2)
+  = do { new_ty1 <- rnLHsType doc ty1
+       ; new_ty2 <- rnLHsType doc ty2
+       ; return (InfixCon new_ty1 new_ty2) }
 
 rnConDeclDetails doc (RecCon fields)
   = do	{ new_fields <- rnConDeclFields doc fields
@@ -1031,7 +1008,7 @@ rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
     rn_at (tydecl@TySynonym {}) = 
       do
         unless (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
-        rnTyClDecl tydecl
+        rnTyClDecl Nothing tydecl
     rn_at _                      = panic "RnSource.rnATs: invalid TyClDecl"
 
     lookupIdxVars tyvars cont = 
@@ -1151,9 +1128,9 @@ rnFds doc fds
   = mapM (wrapLocM rn_fds) fds
   where
     rn_fds (tys1, tys2)
-      =	rnHsTyVars doc tys1		`thenM` \ tys1' ->
-	rnHsTyVars doc tys2		`thenM` \ tys2' ->
-	return (tys1', tys2')
+      =	do { tys1' <- rnHsTyVars doc tys1
+	   ; tys2' <- rnHsTyVars doc tys2
+	   ; return (tys1', tys2') }
 
 rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
 rnHsTyVars doc tvs  = mapM (rnHsTyVar doc) tvs