Merge branch 'master' into wip/ext-solverwip/ext-solver

8 files changed, 223 insertions, 203 deletions

diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index 7251492ccf..e65d3173d6 100644
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -9,7 +9,7 @@ type-synonym declarations; those cannot be done at this stage because
 they may be affected by renaming (which isn't fully worked out yet).
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -476,8 +476,9 @@ rnBind _ bind@(PatBind { pat_lhs = pat
               bndrs = collectPatBinders pat
               bind' = bind { pat_rhs  = grhss', bind_fvs = fvs' }
               is_wild_pat = case pat of
-                              L _ (WildPat {}) -> True
-                              _                -> False
+                              L _ (WildPat {})                 -> True
+                              L _ (BangPat (L _ (WildPat {}))) -> True -- #9127
+                              _                                -> False
 
         -- Warn if the pattern binds no variables, except for the
         -- entirely-explicit idiom    _ = rhs
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 178f722d99..f333a239a1 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -4,6 +4,8 @@
 \section[RnEnv]{Environment manipulation for the renamer monad}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module RnEnv (
         newTopSrcBinder,
         lookupLocatedTopBndrRn, lookupTopBndrRn,
@@ -38,10 +40,7 @@ module RnEnv (
         warnUnusedMatches,
         warnUnusedTopBinds, warnUnusedLocalBinds,
         dataTcOccs, kindSigErr, perhapsForallMsg,
-        HsDocContext(..), docOfHsDocContext, 
-
-        -- FsEnv
-        FastStringEnv, emptyFsEnv, lookupFsEnv, extendFsEnv, mkFsEnv
+        HsDocContext(..), docOfHsDocContext
     ) where
 
 #include "HsVersions.h"
@@ -59,7 +58,6 @@ import NameSet
 import NameEnv
 import Avail
 import Module
-import UniqFM
 import ConLike
 import DataCon          ( dataConFieldLabels, dataConTyCon )
 import TyCon            ( isTupleTyCon, tyConArity )
@@ -270,22 +268,29 @@ lookupExactOcc name
                        ; return name
                        }
 
-           (gre:_) -> return (gre_name gre) }
+           [gre]   -> return (gre_name gre)
+           (gre:_) -> do {addErr dup_nm_err
+                         ; return (gre_name gre)
+                         }
            -- We can get more than one GRE here, if there are multiple 
-           -- bindings for the same name; but there will already be a 
-           -- reported error for the duplicate.  (If we add the error 
-           -- rather than stopping when we encounter it.) 
-           -- So all we need do here is not crash.  
-           -- Example is Trac #8932:
+           -- bindings for the same name. Sometimes they are caught later
+           -- by findLocalDupsRdrEnv, like in this example (Trac #8932):
            --    $( [d| foo :: a->a; foo x = x |])
            --    foo = True
-           -- Here the 'foo' in the splice turns into an Exact Name
+           -- But when the names are totally identical, we panic (Trac #7241):
+           --    $(newName "Foo" >>= \o -> return [DataD [] o [] [RecC o []] [''Show]])
+           -- So, let's emit an error here, even if it will lead to duplication in some cases.
+       }
 
   where
     exact_nm_err = hang (ptext (sLit "The exact Name") <+> quotes (ppr name) <+> ptext (sLit "is not in scope"))
                       2 (vcat [ ptext (sLit "Probable cause: you used a unique Template Haskell name (NameU), ")
                               , ptext (sLit "perhaps via newName, but did not bind it")
                               , ptext (sLit "If that's it, then -ddump-splices might be useful") ])
+    dup_nm_err   = hang (ptext (sLit "Duplicate exact Name") <+> quotes (ppr $ nameOccName name))
+                      2 (vcat [ ptext (sLit "Probable cause: you used a unique Template Haskell name (NameU), ")
+                              , ptext (sLit "perhaps via newName, but bound it multiple times")
+                              , ptext (sLit "If that's it, then -ddump-splices might be useful") ])
 
 -----------------------------------------------
 lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name
@@ -1080,20 +1085,6 @@ deprecation declarations, and lookup of names in GHCi.
 
 \begin{code}
 --------------------------------
-type FastStringEnv a = UniqFM a         -- Keyed by FastString
-
-
-emptyFsEnv  :: FastStringEnv a
-lookupFsEnv :: FastStringEnv a -> FastString -> Maybe a
-extendFsEnv :: FastStringEnv a -> FastString -> a -> FastStringEnv a
-mkFsEnv     :: [(FastString,a)] -> FastStringEnv a
-
-emptyFsEnv  = emptyUFM
-lookupFsEnv = lookupUFM
-extendFsEnv = addToUFM
-mkFsEnv     = listToUFM
-
---------------------------------
 type MiniFixityEnv = FastStringEnv (Located Fixity)
         -- Mini fixity env for the names we're about
         -- to bind, in a single binding group
@@ -1461,7 +1452,7 @@ unknownNameSuggestErr where_look tried_rdr_name
              all_possibilities
                 =  [ (showPpr dflags r, (r, Left loc))
                    | (r,loc) <- local_possibilities local_env ]
-                ++ [ (showPpr dflags r, rp) | (r,rp) <- global_possibilities global_env ]
+                ++ [ (showPpr dflags r, rp) | (r, rp) <- global_possibilities global_env ]
 
              suggest = fuzzyLookup (showPpr dflags tried_rdr_name) all_possibilities
              perhaps = ptext (sLit "Perhaps you meant")
@@ -1473,19 +1464,24 @@ unknownNameSuggestErr where_look tried_rdr_name
        ; return extra_err }
   where
     pp_item :: (RdrName, HowInScope) -> SDoc
-    pp_item (rdr, Left loc) = quotes (ppr rdr) <+> loc' -- Locally defined
+    pp_item (rdr, Left loc) = pp_ns rdr <+> quotes (ppr rdr) <+> loc' -- Locally defined
         where loc' = case loc of
                      UnhelpfulSpan l -> parens (ppr l)
                      RealSrcSpan l -> parens (ptext (sLit "line") <+> int (srcSpanStartLine l))
-    pp_item (rdr, Right is) = quotes (ppr rdr) <+>   -- Imported
+    pp_item (rdr, Right is) = pp_ns rdr <+> quotes (ppr rdr) <+>   -- Imported
                               parens (ptext (sLit "imported from") <+> ppr (is_mod is))
 
+    pp_ns :: RdrName -> SDoc
+    pp_ns rdr | ns /= tried_ns = pprNameSpace ns
+              | otherwise      = empty
+      where ns = rdrNameSpace rdr
+
     tried_occ     = rdrNameOcc tried_rdr_name
     tried_is_sym  = isSymOcc tried_occ
     tried_ns      = occNameSpace tried_occ
     tried_is_qual = isQual tried_rdr_name
 
-    correct_name_space occ =  occNameSpace occ == tried_ns
+    correct_name_space occ =  nameSpacesRelated (occNameSpace occ) tried_ns
                            && isSymOcc occ == tried_is_sym
         -- Treat operator and non-operators as non-matching
         -- This heuristic avoids things like
diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 01e8a4492d..d680292a25 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -10,6 +10,8 @@ general, all of these functions return a renamed thing, and a set of
 free variables.
 
 \begin{code}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
+
 module RnExpr (
         rnLExpr, rnExpr, rnStmts
    ) where
@@ -45,16 +47,6 @@ import Control.Monad
 import TysWiredIn       ( nilDataConName )
 \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}
-
 %************************************************************************
 %*                                                                      *
 \subsubsection{Expressions}
@@ -66,16 +58,13 @@ rnExprs :: [LHsExpr RdrName] -> RnM ([LHsExpr Name], FreeVars)
 rnExprs ls = rnExprs' ls emptyUniqSet
  where
   rnExprs' [] acc = return ([], acc)
-  rnExprs' (expr:exprs) acc
-   = rnLExpr expr               `thenM` \ (expr', fvExpr) ->
-
+  rnExprs' (expr:exprs) acc =
+   do { (expr', fvExpr) <- rnLExpr expr
         -- Now we do a "seq" on the free vars because typically it's small
         -- or empty, especially in very long lists of constants
-    let
-        acc' = acc `plusFV` fvExpr
-    in
-    acc' `seq` rnExprs' exprs acc' `thenM` \ (exprs', fvExprs) ->
-    return (expr':exprs', fvExprs)
+      ; let  acc' = acc `plusFV` fvExpr
+      ; (exprs', fvExprs) <- acc' `seq` rnExprs' exprs acc'
+      ; return (expr':exprs', fvExprs) }
 \end{code}
 
 Variables. We look up the variable and return the resulting name.
@@ -120,27 +109,25 @@ rnExpr (HsIPVar v)
   = return (HsIPVar v, emptyFVs)
 
 rnExpr (HsLit lit@(HsString s))
-  = do {
-         opt_OverloadedStrings <- xoptM Opt_OverloadedStrings
+  = do { opt_OverloadedStrings <- xoptM Opt_OverloadedStrings
        ; if opt_OverloadedStrings then
             rnExpr (HsOverLit (mkHsIsString s placeHolderType))
-         else -- Same as below
-            rnLit lit           `thenM_`
-            return (HsLit lit, emptyFVs)
-       }
+         else do {
+            ; rnLit lit
+            ; return (HsLit lit, emptyFVs) } }
 
 rnExpr (HsLit lit)
-  = rnLit lit           `thenM_`
-    return (HsLit lit, emptyFVs)
+  = do { rnLit lit
+       ; return (HsLit lit, emptyFVs) }
 
 rnExpr (HsOverLit lit)
-  = rnOverLit lit               `thenM` \ (lit', fvs) ->
-    return (HsOverLit lit', fvs)
+  = do { (lit', fvs) <- rnOverLit lit
+       ; return (HsOverLit lit', fvs) }
 
 rnExpr (HsApp fun arg)
-  = rnLExpr fun         `thenM` \ (fun',fvFun) ->
-    rnLExpr arg         `thenM` \ (arg',fvArg) ->
-    return (HsApp fun' arg', fvFun `plusFV` fvArg)
+  = do { (fun',fvFun) <- rnLExpr fun
+       ; (arg',fvArg) <- rnLExpr arg
+       ; return (HsApp fun' arg', fvFun `plusFV` fvArg) }
 
 rnExpr (OpApp e1 (L op_loc (HsVar op_rdr)) _ e2)
   = do  { (e1', fv_e1) <- rnLExpr e1
@@ -163,10 +150,10 @@ rnExpr (OpApp _ other_op _ _)
                    , ptext (sLit "(Probably resulting from a Template Haskell splice)") ])
 
 rnExpr (NegApp e _)
-  = rnLExpr e                   `thenM` \ (e', fv_e) ->
-    lookupSyntaxName negateName `thenM` \ (neg_name, fv_neg) ->
-    mkNegAppRn e' neg_name      `thenM` \ final_e ->
-    return (final_e, fv_e `plusFV` fv_neg)
+  = do { (e', fv_e)         <- rnLExpr e
+       ; (neg_name, fv_neg) <- lookupSyntaxName negateName
+       ; final_e            <- mkNegAppRn e' neg_name
+       ; return (final_e, fv_e `plusFV` fv_neg) }
 
 ------------------------------------------
 -- Template Haskell extensions
@@ -178,10 +165,10 @@ rnExpr (HsSpliceE is_typed splice) = rnSpliceExpr is_typed splice
 
 
 rnExpr (HsQuasiQuoteE qq)
-  = runQuasiQuoteExpr qq        `thenM` \ lexpr' ->
-    -- Wrap the result of the quasi-quoter in parens so that we don't
-    -- lose the outermost location set by runQuasiQuote (#7918) 
-    rnExpr (HsPar lexpr')
+  = do { lexpr' <- runQuasiQuoteExpr qq
+         -- Wrap the result of the quasi-quoter in parens so that we don't
+         -- lose the outermost location set by runQuasiQuote (#7918)
+       ; rnExpr (HsPar lexpr') }
 
 ---------------------------------------------
 --      Sections
@@ -205,33 +192,33 @@ rnExpr expr@(SectionR {})
 
 ---------------------------------------------
 rnExpr (HsCoreAnn ann expr)
-  = rnLExpr expr `thenM` \ (expr', fvs_expr) ->
-    return (HsCoreAnn ann expr', fvs_expr)
+  = do { (expr', fvs_expr) <- rnLExpr expr
+       ; return (HsCoreAnn ann expr', fvs_expr) }
 
 rnExpr (HsSCC lbl expr)
-  = rnLExpr expr                `thenM` \ (expr', fvs_expr) ->
-    return (HsSCC lbl expr', fvs_expr)
+  = do { (expr', fvs_expr) <- rnLExpr expr
+       ; return (HsSCC lbl expr', fvs_expr) }
 rnExpr (HsTickPragma info expr)
-  = rnLExpr expr                `thenM` \ (expr', fvs_expr) ->
-    return (HsTickPragma info expr', fvs_expr)
+  = do { (expr', fvs_expr) <- rnLExpr expr
+       ; return (HsTickPragma info expr', fvs_expr) }
 
 rnExpr (HsLam matches)
-  = rnMatchGroup LambdaExpr rnLExpr matches     `thenM` \ (matches', fvMatch) ->
-    return (HsLam matches', fvMatch)
+  = do { (matches', fvMatch) <- rnMatchGroup LambdaExpr rnLExpr matches
+       ; return (HsLam matches', fvMatch) }
 
 rnExpr (HsLamCase arg matches)
-  = rnMatchGroup CaseAlt rnLExpr matches        `thenM` \ (matches', fvs_ms) ->
-    return (HsLamCase arg matches', fvs_ms)
+  = do { (matches', fvs_ms) <- rnMatchGroup CaseAlt rnLExpr matches
+       ; return (HsLamCase arg matches', fvs_ms) }
 
 rnExpr (HsCase expr matches)
-  = rnLExpr expr                                `thenM` \ (new_expr, e_fvs) ->
-    rnMatchGroup CaseAlt rnLExpr matches        `thenM` \ (new_matches, ms_fvs) ->
-    return (HsCase new_expr new_matches, e_fvs `plusFV` ms_fvs)
+  = do { (new_expr, e_fvs) <- rnLExpr expr
+       ; (new_matches, ms_fvs) <- rnMatchGroup CaseAlt rnLExpr matches
+       ; return (HsCase new_expr new_matches, e_fvs `plusFV` ms_fvs) }
 
 rnExpr (HsLet binds expr)
-  = rnLocalBindsAndThen binds           $ \ binds' ->
-    rnLExpr expr                         `thenM` \ (expr',fvExpr) ->
-    return (HsLet binds' expr', fvExpr)
+  = rnLocalBindsAndThen binds $ \binds' -> do
+      { (expr',fvExpr) <- rnLExpr expr
+      ; return (HsLet binds' expr', fvExpr) }
 
 rnExpr (HsDo do_or_lc stmts _)
   = do  { ((stmts', _), fvs) <- rnStmts do_or_lc rnLExpr stmts (\ _ -> return ((), emptyFVs))
@@ -248,8 +235,8 @@ rnExpr (ExplicitList _ _  exps)
             return  (ExplicitList placeHolderType Nothing exps', fvs) }
 
 rnExpr (ExplicitPArr _ exps)
-  = rnExprs exps                        `thenM` \ (exps', fvs) ->
-    return  (ExplicitPArr placeHolderType exps', fvs)
+  = do { (exps', fvs) <- rnExprs exps
+       ; return  (ExplicitPArr placeHolderType exps', fvs) }
 
 rnExpr (ExplicitTuple tup_args boxity)
   = do { checkTupleSection tup_args
@@ -290,8 +277,8 @@ rnExpr (HsMultiIf ty alts)
        ; return (HsMultiIf ty alts', fvs) }
 
 rnExpr (HsType a)
-  = rnLHsType HsTypeCtx a       `thenM` \ (t, fvT) ->
-    return (HsType t, fvT)
+  = do { (t, fvT) <- rnLHsType HsTypeCtx a
+       ; return (HsType t, fvT) }
 
 rnExpr (ArithSeq _ _ seq)
   = do { opt_OverloadedLists <- xoptM Opt_OverloadedLists
@@ -304,8 +291,8 @@ rnExpr (ArithSeq _ _ seq)
             return (ArithSeq noPostTcExpr Nothing new_seq, fvs) }
 
 rnExpr (PArrSeq _ seq)
-  = rnArithSeq seq       `thenM` \ (new_seq, fvs) ->
-    return (PArrSeq noPostTcExpr new_seq, fvs)
+  = do { (new_seq, fvs) <- rnArithSeq seq
+       ; return (PArrSeq noPostTcExpr new_seq, fvs) }
 \end{code}
 
 These three are pattern syntax appearing in expressions.
@@ -332,9 +319,9 @@ rnExpr e@(ELazyPat {}) = patSynErr e
 \begin{code}
 rnExpr (HsProc pat body)
   = newArrowScope $
-    rnPat ProcExpr pat $ \ pat' ->
-    rnCmdTop body                `thenM` \ (body',fvBody) ->
-    return (HsProc pat' body', fvBody)
+    rnPat ProcExpr pat $ \ pat' -> do
+      { (body',fvBody) <- rnCmdTop body
+      ; return (HsProc pat' body', fvBody) }
 
 -- Ideally, these would be done in parsing, but to keep parsing simple, we do it here.
 rnExpr e@(HsArrApp {})  = arrowFail e
@@ -402,9 +389,9 @@ rnHsRecBinds ctxt rec_binds@(HsRecFields { rec_dotdot = dd })
 rnCmdArgs :: [LHsCmdTop RdrName] -> RnM ([LHsCmdTop Name], FreeVars)
 rnCmdArgs [] = return ([], emptyFVs)
 rnCmdArgs (arg:args)
-  = rnCmdTop arg        `thenM` \ (arg',fvArg) ->
-    rnCmdArgs args      `thenM` \ (args',fvArgs) ->
-    return (arg':args', fvArg `plusFV` fvArgs)
+  = do { (arg',fvArg) <- rnCmdTop arg
+       ; (args',fvArgs) <- rnCmdArgs args
+       ; return (arg':args', fvArg `plusFV` fvArgs) }
 
 rnCmdTop :: LHsCmdTop RdrName -> RnM (LHsCmdTop Name, FreeVars)
 rnCmdTop = wrapLocFstM rnCmdTop'
@@ -425,10 +412,10 @@ rnLCmd = wrapLocFstM rnCmd
 rnCmd :: HsCmd RdrName -> RnM (HsCmd Name, FreeVars)
 
 rnCmd (HsCmdArrApp arrow arg _ ho rtl)
-  = select_arrow_scope (rnLExpr arrow)  `thenM` \ (arrow',fvArrow) ->
-    rnLExpr arg                         `thenM` \ (arg',fvArg) ->
-    return (HsCmdArrApp arrow' arg' placeHolderType ho rtl,
-             fvArrow `plusFV` fvArg)
+  = do { (arrow',fvArrow) <- select_arrow_scope (rnLExpr arrow)
+       ; (arg',fvArg) <- rnLExpr arg
+       ; return (HsCmdArrApp arrow' arg' placeHolderType ho rtl,
+                 fvArrow `plusFV` fvArg) }
   where
     select_arrow_scope tc = case ho of
         HsHigherOrderApp -> tc
@@ -441,42 +428,37 @@ rnCmd (HsCmdArrApp arrow arg _ ho rtl)
 
 -- infix form
 rnCmd (HsCmdArrForm op (Just _) [arg1, arg2])
-  = escapeArrowScope (rnLExpr op)
-                        `thenM` \ (op',fv_op) ->
-    let L _ (HsVar op_name) = op' in
-    rnCmdTop arg1       `thenM` \ (arg1',fv_arg1) ->
-    rnCmdTop arg2       `thenM` \ (arg2',fv_arg2) ->
-
+  = do { (op',fv_op) <- escapeArrowScope (rnLExpr op)
+       ; let L _ (HsVar op_name) = op'
+       ; (arg1',fv_arg1) <- rnCmdTop arg1
+       ; (arg2',fv_arg2) <- rnCmdTop arg2
         -- Deal with fixity
-
-    lookupFixityRn op_name              `thenM` \ fixity ->
-    mkOpFormRn arg1' op' fixity arg2'   `thenM` \ final_e ->
-
-    return (final_e,
-              fv_arg1 `plusFV` fv_op `plusFV` fv_arg2)
+       ; fixity <- lookupFixityRn op_name
+       ; final_e <- mkOpFormRn arg1' op' fixity arg2'
+       ; return (final_e, fv_arg1 `plusFV` fv_op `plusFV` fv_arg2) }
 
 rnCmd (HsCmdArrForm op fixity cmds)
-  = escapeArrowScope (rnLExpr op)       `thenM` \ (op',fvOp) ->
-    rnCmdArgs cmds                      `thenM` \ (cmds',fvCmds) ->
-    return (HsCmdArrForm op' fixity cmds', fvOp `plusFV` fvCmds)
+  = do { (op',fvOp) <- escapeArrowScope (rnLExpr op)
+       ; (cmds',fvCmds) <- rnCmdArgs cmds
+       ; return (HsCmdArrForm op' fixity cmds', fvOp `plusFV` fvCmds) }
 
 rnCmd (HsCmdApp fun arg)
-  = rnLCmd  fun         `thenM` \ (fun',fvFun) ->
-    rnLExpr arg         `thenM` \ (arg',fvArg) ->
-    return (HsCmdApp fun' arg', fvFun `plusFV` fvArg)
+  = do { (fun',fvFun) <- rnLCmd  fun
+       ; (arg',fvArg) <- rnLExpr arg
+       ; return (HsCmdApp fun' arg', fvFun `plusFV` fvArg) }
 
 rnCmd (HsCmdLam matches)
-  = rnMatchGroup LambdaExpr rnLCmd matches     `thenM` \ (matches', fvMatch) ->
-    return (HsCmdLam matches', fvMatch)
+  = do { (matches', fvMatch) <- rnMatchGroup LambdaExpr rnLCmd matches
+       ; return (HsCmdLam matches', fvMatch) }
 
 rnCmd (HsCmdPar e)
   = do  { (e', fvs_e) <- rnLCmd e
         ; return (HsCmdPar e', fvs_e) }
 
 rnCmd (HsCmdCase expr matches)
-  = rnLExpr expr                        `thenM` \ (new_expr, e_fvs) ->
-    rnMatchGroup CaseAlt rnLCmd matches `thenM` \ (new_matches, ms_fvs) ->
-    return (HsCmdCase new_expr new_matches, e_fvs `plusFV` ms_fvs)
+  = do { (new_expr, e_fvs) <- rnLExpr expr
+       ; (new_matches, ms_fvs) <- rnMatchGroup CaseAlt rnLCmd matches
+       ; return (HsCmdCase new_expr new_matches, e_fvs `plusFV` ms_fvs) }
 
 rnCmd (HsCmdIf _ p b1 b2)
   = do { (p', fvP) <- rnLExpr p
@@ -486,9 +468,9 @@ rnCmd (HsCmdIf _ p b1 b2)
        ; return (HsCmdIf mb_ite p' b1' b2', plusFVs [fvITE, fvP, fvB1, fvB2]) }
 
 rnCmd (HsCmdLet binds cmd)
-  = rnLocalBindsAndThen binds           $ \ binds' ->
-    rnLCmd cmd                         `thenM` \ (cmd',fvExpr) ->
-    return (HsCmdLet binds' cmd', fvExpr)
+  = rnLocalBindsAndThen binds $ \ binds' -> do
+      { (cmd',fvExpr) <- rnLCmd cmd
+      ; return (HsCmdLet binds' cmd', fvExpr) }
 
 rnCmd (HsCmdDo stmts _)
   = do  { ((stmts', _), fvs) <- rnStmts ArrowExpr rnLCmd stmts (\ _ -> return ((), emptyFVs))
@@ -578,25 +560,25 @@ methodNamesStmt (TransStmt {})                   = emptyFVs
 \begin{code}
 rnArithSeq :: ArithSeqInfo RdrName -> RnM (ArithSeqInfo Name, FreeVars)
 rnArithSeq (From expr)
- = rnLExpr expr         `thenM` \ (expr', fvExpr) ->
-   return (From expr', fvExpr)
+ = do { (expr', fvExpr) <- rnLExpr expr
+      ; return (From expr', fvExpr) }
 
 rnArithSeq (FromThen expr1 expr2)
- = rnLExpr expr1        `thenM` \ (expr1', fvExpr1) ->
-   rnLExpr expr2        `thenM` \ (expr2', fvExpr2) ->
-   return (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2)
+ = do { (expr1', fvExpr1) <- rnLExpr expr1
+      ; (expr2', fvExpr2) <- rnLExpr expr2
+      ; return (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2) }
 
 rnArithSeq (FromTo expr1 expr2)
- = rnLExpr expr1        `thenM` \ (expr1', fvExpr1) ->
-   rnLExpr expr2        `thenM` \ (expr2', fvExpr2) ->
-   return (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
+ = do { (expr1', fvExpr1) <- rnLExpr expr1
+      ; (expr2', fvExpr2) <- rnLExpr expr2
+      ; return (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2) }
 
 rnArithSeq (FromThenTo expr1 expr2 expr3)
- = rnLExpr expr1        `thenM` \ (expr1', fvExpr1) ->
-   rnLExpr expr2        `thenM` \ (expr2', fvExpr2) ->
-   rnLExpr expr3        `thenM` \ (expr3', fvExpr3) ->
-   return (FromThenTo expr1' expr2' expr3',
-            plusFVs [fvExpr1, fvExpr2, fvExpr3])
+ = do { (expr1', fvExpr1) <- rnLExpr expr1
+      ; (expr2', fvExpr2) <- rnLExpr expr2
+      ; (expr3', fvExpr3) <- rnLExpr expr3
+      ; return (FromThenTo expr1' expr2' expr3',
+                plusFVs [fvExpr1, fvExpr2, fvExpr3]) }
 \end{code}
 
 %************************************************************************
@@ -959,21 +941,19 @@ rn_rec_stmt rnBody _ (L loc (LastStmt body _)) _
                    L loc (LastStmt body' ret_op))] }
 
 rn_rec_stmt rnBody _ (L loc (BodyStmt body _ _ _)) _
-  = rnBody body `thenM` \ (body', fvs) ->
-    lookupSyntaxName thenMName  `thenM` \ (then_op, fvs1) ->
-    return [(emptyNameSet, fvs `plusFV` fvs1, emptyNameSet,
-              L loc (BodyStmt body' then_op noSyntaxExpr placeHolderType))]
+  = do { (body', fvs) <- rnBody body
+       ; (then_op, fvs1) <- lookupSyntaxName thenMName
+       ; return [(emptyNameSet, fvs `plusFV` fvs1, emptyNameSet,
+                 L loc (BodyStmt body' then_op noSyntaxExpr placeHolderType))] }
 
 rn_rec_stmt rnBody _ (L loc (BindStmt pat' body _ _)) fv_pat
-  = rnBody body         `thenM` \ (body', fv_expr) ->
-    lookupSyntaxName bindMName  `thenM` \ (bind_op, fvs1) ->
-    lookupSyntaxName failMName  `thenM` \ (fail_op, fvs2) ->
-    let
-        bndrs = mkNameSet (collectPatBinders pat')
-        fvs   = fv_expr `plusFV` fv_pat `plusFV` fvs1 `plusFV` fvs2
-    in
-    return [(bndrs, fvs, bndrs `intersectNameSet` fvs,
-              L loc (BindStmt pat' body' bind_op fail_op))]
+  = do { (body', fv_expr) <- rnBody body
+       ; (bind_op, fvs1) <- lookupSyntaxName bindMName
+       ; (fail_op, fvs2) <- lookupSyntaxName failMName
+       ; let bndrs = mkNameSet (collectPatBinders pat')
+             fvs   = fv_expr `plusFV` fv_pat `plusFV` fvs1 `plusFV` fvs2
+       ; return [(bndrs, fvs, bndrs `intersectNameSet` fvs,
+                  L loc (BindStmt pat' body' bind_op fail_op))] }
 
 rn_rec_stmt _ _ (L _ (LetStmt binds@(HsIPBinds _))) _
   = failWith (badIpBinds (ptext (sLit "an mdo expression")) binds)
@@ -1003,9 +983,9 @@ rn_rec_stmts :: Outputable (body RdrName) =>
              -> [Name]
              -> [(LStmtLR Name RdrName (Located (body RdrName)), FreeVars)]
              -> RnM [Segment (LStmt Name (Located (body Name)))]
-rn_rec_stmts rnBody bndrs stmts =
-    mapM (uncurry (rn_rec_stmt rnBody bndrs)) stmts     `thenM` \ segs_s ->
-    return (concat segs_s)
+rn_rec_stmts rnBody bndrs stmts
+  = do { segs_s <- mapM (uncurry (rn_rec_stmt rnBody bndrs)) stmts
+       ; return (concat segs_s) }
 
 ---------------------------------------------
 segmentRecStmts :: HsStmtContext Name 
diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 7f6a840295..db4258607a 100644
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -4,6 +4,8 @@
 \section[RnNames]{Extracting imported and top-level names in scope}
 
 \begin{code}
+{-# LANGUAGE CPP, NondecreasingIndentation #-}
+
 module RnNames (
         rnImports, getLocalNonValBinders,
         rnExports, extendGlobalRdrEnvRn,
@@ -1301,11 +1303,14 @@ type ImportDeclUsage
 warnUnusedImportDecls :: TcGblEnv -> RnM ()
 warnUnusedImportDecls gbl_env
   = do { uses <- readMutVar (tcg_used_rdrnames gbl_env)
-       ; let imports = filter explicit_import (tcg_rn_imports gbl_env)
+       ; let user_imports = filterOut (ideclImplicit . unLoc) (tcg_rn_imports gbl_env)
+                            -- This whole function deals only with *user* imports
+                            -- both for warning about unnecessary ones, and for
+                            -- deciding the minimal ones
              rdr_env = tcg_rdr_env gbl_env
 
        ; let usage :: [ImportDeclUsage]
-             usage = findImportUsage imports rdr_env (Set.elems uses)
+             usage = findImportUsage user_imports rdr_env (Set.elems uses)
 
        ; traceRn (vcat [ ptext (sLit "Uses:") <+> ppr (Set.elems uses)
                        , ptext (sLit "Import usage") <+> ppr usage])
@@ -1314,10 +1319,6 @@ warnUnusedImportDecls gbl_env
 
        ; whenGOptM Opt_D_dump_minimal_imports $
          printMinimalImports usage }
-  where
-    explicit_import (L _ decl) = not (ideclImplicit decl)
-        -- Filter out the implicit Prelude import
-        -- which we do not want to bleat about
 \end{code}
 
 
@@ -1433,6 +1434,11 @@ warnUnusedImport :: ImportDeclUsage -> RnM ()
 warnUnusedImport (L loc decl, used, unused)
   | Just (False,[]) <- ideclHiding decl
                 = return ()            -- Do not warn for 'import M()'
+
+  | Just (True, hides) <- ideclHiding decl
+  , not (null hides)
+  , pRELUDE_NAME == unLoc (ideclName decl)
+                = return ()            -- Note [Do not warn about Prelude hiding]
   | null used   = addWarnAt loc msg1   -- Nothing used; drop entire decl
   | null unused = return ()            -- Everything imported is used; nop
   | otherwise   = addWarnAt loc msg2   -- Some imports are unused
@@ -1452,6 +1458,19 @@ warnUnusedImport (L loc decl, used, unused)
     pp_not_used = text "is redundant"
 \end{code}
 
+Note [Do not warn about Prelude hiding]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We do not warn about
+   import Prelude hiding( x, y )
+because even if nothing else from Prelude is used, it may be essential to hide
+x,y to avoid name-shadowing warnings.  Example (Trac #9061)
+   import Prelude hiding( log )
+   f x = log where log = ()
+
+
+
+Note [Printing minimal imports]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 To print the minimal imports we walk over the user-supplied import
 decls, and simply trim their import lists.  NB that
 
@@ -1462,6 +1481,7 @@ decls, and simply trim their import lists.  NB that
 
 \begin{code}
 printMinimalImports :: [ImportDeclUsage] -> RnM ()
+-- See Note [Printing minimal imports]
 printMinimalImports imports_w_usage
   = do { imports' <- mapM mk_minimal imports_w_usage
        ; this_mod <- getModule
diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs
index 3c48f34032..48fffce374 100644
--- a/compiler/rename/RnPat.lhs
+++ b/compiler/rename/RnPat.lhs
@@ -10,13 +10,8 @@ general, all of these functions return a renamed thing, and a set of
 free variables.
 
 \begin{code}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
+{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
 
-{-# LANGUAGE ScopedTypeVariables #-}
 module RnPat (-- main entry points
               rnPat, rnPats, rnBindPat, rnPatAndThen,
 
@@ -439,7 +434,7 @@ rnPatAndThen mk (PArrPat pats _)
 rnPatAndThen mk (TuplePat pats boxed _)
   = do { liftCps $ checkTupSize (length pats)
        ; pats' <- rnLPatsAndThen mk pats
-       ; return (TuplePat pats' boxed placeHolderType) }
+       ; return (TuplePat pats' boxed []) }
 
 rnPatAndThen _ (SplicePat splice)
   = do { -- XXX How to deal with free variables?
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index fbc22c0c28..9bc0e44780 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -4,6 +4,8 @@
 \section[RnSource]{Main pass of renamer}
 
 \begin{code}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
+
 module RnSource (
         rnSrcDecls, addTcgDUs, rnTyClDecls, findSplice
     ) where
@@ -443,12 +445,14 @@ rnSrcInstDecl (ClsInstD { cid_inst = cid })
 rnClsInstDecl :: ClsInstDecl RdrName -> RnM (ClsInstDecl Name, FreeVars)
 rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
                            , cid_sigs = uprags, cid_tyfam_insts = ats
+                           , cid_overlap_mode = oflag
                            , cid_datafam_insts = adts })
         -- Used for both source and interface file decls
   = do { (inst_ty', inst_fvs) <- rnLHsInstType (text "In an instance declaration") inst_ty
        ; case splitLHsInstDeclTy_maybe inst_ty' of {
            Nothing -> return (ClsInstDecl { cid_poly_ty = inst_ty', cid_binds = emptyLHsBinds
                                           , cid_sigs = [], cid_tyfam_insts = []
+                                          , cid_overlap_mode = oflag
                                           , cid_datafam_insts = [] }
                              , inst_fvs) ;
            Just (inst_tyvars, _, L _ cls,_) ->
@@ -461,7 +465,7 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
        ; traceRn (text "rnSrcInstDecl"  <+> ppr inst_ty' $$ ppr inst_tyvars $$ ppr ktv_names)
        ; ((ats', adts', other_sigs'), more_fvs) 
              <- extendTyVarEnvFVRn ktv_names $
-                do { (ats', at_fvs) <- rnATInstDecls rnTyFamInstDecl cls inst_tyvars ats
+                do { (ats',  at_fvs)  <- rnATInstDecls rnTyFamInstDecl cls inst_tyvars ats
                    ; (adts', adt_fvs) <- rnATInstDecls rnDataFamInstDecl cls inst_tyvars adts
                    ; (other_sigs', sig_fvs) <- renameSigs (InstDeclCtxt cls) other_sigs
                    ; return ( (ats', adts', other_sigs')
@@ -491,6 +495,7 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
                           `plusFV` inst_fvs
        ; return (ClsInstDecl { cid_poly_ty = inst_ty', cid_binds = mbinds'
                              , cid_sigs = uprags', cid_tyfam_insts = ats'
+                             , cid_overlap_mode = oflag
                              , cid_datafam_insts = adts' },
                  all_fvs) } } }
              -- We return the renamed associated data type declarations so
@@ -559,14 +564,29 @@ rnTyFamInstDecl mb_cls (TyFamInstDecl { tfid_eqn = L loc eqn })
 rnTyFamInstEqn :: Maybe (Name, [Name])
                -> TyFamInstEqn RdrName
                -> RnM (TyFamInstEqn Name, FreeVars)
-rnTyFamInstEqn mb_cls (TyFamInstEqn { tfie_tycon = tycon
-                                    , tfie_pats  = HsWB { hswb_cts = pats }
-                                    , tfie_rhs   = rhs })
+rnTyFamInstEqn mb_cls (TyFamEqn { tfe_tycon = tycon
+                                , tfe_pats  = HsWB { hswb_cts = pats }
+                                , tfe_rhs   = rhs })
   = do { (tycon', pats', rhs', fvs) <-
            rnFamInstDecl (TySynCtx tycon) mb_cls tycon pats rhs rnTySyn
-       ; return (TyFamInstEqn { tfie_tycon = tycon'
-                              , tfie_pats  = pats'
-                              , tfie_rhs   = rhs' }, fvs) }
+       ; return (TyFamEqn { tfe_tycon = tycon'
+                          , tfe_pats  = pats'
+                          , tfe_rhs   = rhs' }, fvs) }
+
+rnTyFamDefltEqn :: Name
+                -> TyFamDefltEqn RdrName
+                -> RnM (TyFamDefltEqn Name, FreeVars)
+rnTyFamDefltEqn cls (TyFamEqn { tfe_tycon = tycon
+                              , tfe_pats  = tyvars
+                              , tfe_rhs   = rhs })
+  = bindHsTyVars ctx (Just cls) [] tyvars $ \ tyvars' ->
+    do { tycon'      <- lookupFamInstName (Just cls) tycon
+       ; (rhs', fvs) <- rnLHsType ctx rhs
+       ; return (TyFamEqn { tfe_tycon = tycon'
+                          , tfe_pats  = tyvars'
+                          , tfe_rhs   = rhs' }, fvs) }
+  where
+    ctx = TyFamilyCtx tycon
 
 rnDataFamInstDecl :: Maybe (Name, [Name])
                   -> DataFamInstDecl RdrName
@@ -585,7 +605,7 @@ rnDataFamInstDecl mb_cls (DataFamInstDecl { dfid_tycon = tycon
 Renaming of the associated types in instances.
 
 \begin{code}
--- rename associated type family decl in class
+-- Rename associated type family decl in class
 rnATDecls :: Name      -- Class
           -> [LFamilyDecl RdrName] 
           -> RnM ([LFamilyDecl Name], FreeVars)
@@ -635,11 +655,11 @@ extendTyVarEnvForMethodBinds ktv_names thing_inside
 
 \begin{code}
 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
-rnSrcDerivDecl (DerivDecl ty)
+rnSrcDerivDecl (DerivDecl ty overlap)
   = do { standalone_deriv_ok <- xoptM Opt_StandaloneDeriving
        ; unless standalone_deriv_ok (addErr standaloneDerivErr)
        ; (ty', fvs) <- rnLHsInstType (text "In a deriving declaration") ty
-       ; return (DerivDecl ty', fvs) }
+       ; return (DerivDecl ty' overlap, fvs) }
 
 standaloneDerivErr :: SDoc
 standaloneDerivErr
@@ -936,7 +956,7 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, tcdRhs = rhs })
                                     do { (rhs', fvs) <- rnTySyn doc rhs
                                        ; return ((tyvars', rhs'), fvs) }
        ; return (SynDecl { tcdLName = tycon', tcdTyVars = tyvars'
-                        , tcdRhs = rhs', tcdFVs = fvs }, fvs) }
+                         , tcdRhs = rhs', tcdFVs = fvs }, fvs) }
 
 -- "data", "newtype" declarations
 -- both top level and (for an associated type) in an instance decl
@@ -961,20 +981,20 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = lcls,
                         -- kind signatures on the tyvars
 
         -- Tyvars scope over superclass context and method signatures
-        ; ((tyvars', context', fds', ats', at_defs', sigs'), stuff_fvs)
+        ; ((tyvars', context', fds', ats', sigs'), stuff_fvs)
             <- bindHsTyVars cls_doc Nothing kvs tyvars $ \ tyvars' -> do
                   -- Checks for distinct tyvars
              { (context', cxt_fvs) <- rnContext cls_doc context
-             ; fds'  <- rnFds (docOfHsDocContext cls_doc) fds
+             ; fds'  <- rnFds fds
                          -- The fundeps have no free variables
              ; (ats',     fv_ats)     <- rnATDecls cls' ats
-             ; (at_defs', fv_at_defs) <- rnATInstDecls rnTyFamInstDecl cls' tyvars' at_defs
              ; (sigs', sig_fvs) <- renameSigs (ClsDeclCtxt cls') sigs
              ; let fvs = cxt_fvs     `plusFV`
                          sig_fvs     `plusFV`
-                         fv_ats      `plusFV`
-                         fv_at_defs
-             ; return ((tyvars', context', fds', ats', at_defs', sigs'), fvs) }
+                         fv_ats
+             ; return ((tyvars', context', fds', ats', sigs'), fvs) }
+
+        ; (at_defs', fv_at_defs) <- rnList (rnTyFamDefltEqn cls') at_defs
 
         -- No need to check for duplicate associated type decls
         -- since that is done by RnNames.extendGlobalRdrEnvRn
@@ -1006,7 +1026,7 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = lcls,
   -- Haddock docs
         ; docs' <- mapM (wrapLocM rnDocDecl) docs
 
-        ; let all_fvs = meth_fvs `plusFV` stuff_fvs
+        ; let all_fvs = meth_fvs `plusFV` stuff_fvs `plusFV` fv_at_defs
         ; return (ClassDecl { tcdCtxt = context', tcdLName = lcls',
                               tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
                               tcdMeths = mbinds', tcdATs = ats', tcdATDefs = at_defs',
@@ -1404,21 +1424,20 @@ extendRecordFieldEnv tycl_decls inst_decls
 %*********************************************************
 
 \begin{code}
-rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
-
-rnFds doc fds
+rnFds :: [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
+rnFds fds
   = mapM (wrapLocM rn_fds) fds
   where
     rn_fds (tys1, tys2)
-      = do { tys1' <- rnHsTyVars doc tys1
-           ; tys2' <- rnHsTyVars doc tys2
+      = do { tys1' <- rnHsTyVars tys1
+           ; tys2' <- rnHsTyVars tys2
            ; return (tys1', tys2') }
 
-rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
-rnHsTyVars doc tvs  = mapM (rnHsTyVar doc) tvs
+rnHsTyVars :: [RdrName] -> RnM [Name]
+rnHsTyVars tvs  = mapM rnHsTyVar tvs
 
-rnHsTyVar :: SDoc -> RdrName -> RnM Name
-rnHsTyVar _doc tyvar = lookupOccRn tyvar
+rnHsTyVar :: RdrName -> RnM Name
+rnHsTyVar tyvar = lookupOccRn tyvar
 \end{code}
 
 
diff --git a/compiler/rename/RnSplice.lhs b/compiler/rename/RnSplice.lhs
index e0614d4248..3c0c145e6b 100644
--- a/compiler/rename/RnSplice.lhs
+++ b/compiler/rename/RnSplice.lhs
@@ -1,4 +1,6 @@
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module RnSplice (
         rnTopSpliceDecls,
         rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl,
diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index 23c54c3bed..2f9bfdd653 100644
--- a/compiler/rename/RnTypes.lhs
+++ b/compiler/rename/RnTypes.lhs
@@ -4,6 +4,8 @@
 \section[RnSource]{Main pass of renamer}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module RnTypes (
         -- Type related stuff
         rnHsType, rnLHsType, rnLHsTypes, rnContext,
@@ -360,8 +362,9 @@ bindHsTyVars doc mb_assoc kv_bndrs tv_bndrs thing_inside
              kvs_from_tv_bndrs = [ kv | L _ (KindedTyVar _ kind) <- tvs
                                  , let (_, kvs) = extractHsTyRdrTyVars kind
                                  , kv <- kvs ]
-             all_kvs = filterOut (`elemLocalRdrEnv` rdr_env) $
-                       nub (kv_bndrs ++ kvs_from_tv_bndrs)
+             all_kvs' = nub (kv_bndrs ++ kvs_from_tv_bndrs)
+             all_kvs  = filterOut (`elemLocalRdrEnv` rdr_env) all_kvs'
+
              overlap_kvs = [ kv | kv <- all_kvs, any ((==) kv . hsLTyVarName) tvs ]
                 -- These variables appear both as kind and type variables
                 -- in the same declaration; eg  type family  T (x :: *) (y :: x)
@@ -395,8 +398,12 @@ bindHsTyVars doc mb_assoc kv_bndrs tv_bndrs thing_inside
 
        ; (tv_bndrs', fvs1) <- mapFvRn rn_tv_bndr tvs
        ; (res, fvs2) <- bindLocalNamesFV (map hsLTyVarName tv_bndrs') $
-                        do { env <- getLocalRdrEnv
-                           ; traceRn (text "bhtv" <+> (ppr tvs $$ ppr all_kvs $$ ppr env))
+                        do { inner_rdr_env <- getLocalRdrEnv
+                           ; traceRn (text "bhtv" <+> vcat
+                                 [ ppr tvs, ppr kv_bndrs, ppr kvs_from_tv_bndrs
+                                 , ppr $ map (`elemLocalRdrEnv` rdr_env) all_kvs'
+                                 , ppr $ map (getUnique . rdrNameOcc) all_kvs'
+                                 , ppr all_kvs, ppr rdr_env, ppr inner_rdr_env ])
                            ; thing_inside (HsQTvs { hsq_tvs = tv_bndrs', hsq_kvs = kv_names }) }
        ; return (res, fvs1 `plusFV` fvs2) } }