Print which warning-flag controls an emitted warning
[ghc.git] / compiler / rename / RnEnv.hs
index 3dcf2cc..0ecd85e 100644 (file)
@@ -4,7 +4,7 @@
 \section[RnEnv]{Environment manipulation for the renamer monad}
 -}
 
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, MultiWayIf #-}
 
 module RnEnv (
         newTopSrcBinder,
@@ -13,18 +13,22 @@ module RnEnv (
         lookupLocalOccRn_maybe, lookupInfoOccRn,
         lookupLocalOccThLvl_maybe,
         lookupTypeOccRn, lookupKindOccRn,
-        lookupGlobalOccRn, lookupGlobalOccRn_maybe,
+        lookupGlobalOccRn, lookupGlobalOccRnExport, lookupGlobalOccRn_maybe,
+        lookupOccRn_overloaded, lookupGlobalOccRn_overloaded,
         reportUnboundName, unknownNameSuggestions,
+        addNameClashErrRn,
 
         HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn,
         lookupSigCtxtOccRn,
 
-        lookupFixityRn, lookupTyFixityRn,
-        lookupInstDeclBndr, lookupSubBndrOcc, lookupFamInstName,
-        lookupSubBndrGREs, lookupConstructorFields,
+        lookupFixityRn, lookupFixityRn_help,
+        lookupFieldFixityRn, lookupTyFixityRn,
+        lookupInstDeclBndr, lookupRecFieldOcc, lookupFamInstName,
+        lookupConstructorFields,
         lookupSyntaxName, lookupSyntaxNames, lookupIfThenElse,
         lookupGreAvailRn,
-        getLookupOccRn, addUsedRdrNames,
+        getLookupOccRn,mkUnboundName, mkUnboundNameRdr, isUnboundName,
+        addUsedGRE, addUsedGREs, addUsedDataCons,
 
         newLocalBndrRn, newLocalBndrsRn,
         bindLocalNames, bindLocalNamesFV,
@@ -34,12 +38,15 @@ module RnEnv (
         extendTyVarEnvFVRn,
 
         checkDupRdrNames, checkShadowedRdrNames,
-        checkDupNames, checkDupAndShadowedNames, checkTupSize,
+        checkDupNames, checkDupAndShadowedNames, dupNamesErr,
+        checkTupSize,
         addFvRn, mapFvRn, mapMaybeFvRn, mapFvRnCPS,
-        warnUnusedMatches,
+        warnUnusedMatches, warnUnusedTypePatterns,
         warnUnusedTopBinds, warnUnusedLocalBinds,
-        dataTcOccs, kindSigErr, perhapsForallMsg,
-        HsDocContext(..), docOfHsDocContext
+        mkFieldEnv,
+        dataTcOccs, kindSigErr, perhapsForallMsg, unknownSubordinateErr,
+        HsDocContext(..), pprHsDocContext,
+        inHsDocContext, withHsDocContext
     ) where
 
 #include "HsVersions.h"
@@ -49,18 +56,18 @@ import IfaceEnv
 import HsSyn
 import RdrName
 import HscTypes
-import TcEnv            ( tcLookupDataCon, tcLookupField, isBrackStage )
+import TcEnv
 import TcRnMonad
 import RdrHsSyn         ( setRdrNameSpace )
-import Id               ( isRecordSelector )
+import TysWiredIn       ( starKindTyConName, unicodeStarKindTyConName )
 import Name
 import NameSet
 import NameEnv
 import Avail
 import Module
 import ConLike
-import DataCon          ( dataConFieldLabels, dataConTyCon )
-import TyCon            ( isTupleTyCon, tyConArity )
+import DataCon
+import TyCon
 import PrelNames        ( mkUnboundName, isUnboundName, rOOT_MAIN, forall_tv_RDR )
 import ErrUtils         ( MsgDoc )
 import BasicTypes       ( Fixity(..), FixityDirection(..), minPrecedence, defaultFixity )
@@ -74,9 +81,10 @@ import DynFlags
 import FastString
 import Control.Monad
 import Data.List
-import qualified Data.Set as Set
+import Data.Function    ( on )
 import ListSetOps       ( minusList )
 import Constants        ( mAX_TUPLE_SIZE )
+import qualified GHC.LanguageExtensions as LangExt
 
 {-
 *********************************************************
@@ -139,7 +147,7 @@ One might conceivably want to report deprecation warnings when compiling
 ASig with -sig-of B, in which case we need to look at B.hi to find the
 deprecation warnings during renaming.  At the moment, you don't get any
 warning until you use the identifier further downstream.  This would
-require adjusting addUsedRdrName so that during signature compilation,
+require adjusting addUsedGRE so that during signature compilation,
 we do not report deprecation warnings for LocalDef.  See also
 Note [Handling of deprecations]
 -}
@@ -211,7 +219,7 @@ newTopSrcBinder (L loc rdr_name)
                     -- information later
                     [GRE{ gre_name = n }] -> do
                       -- NB: Just adding this line will not work:
-                      --    addUsedRdrName True gre rdr_name
+                      --    addUsedGRE True gre
                       -- see Note [Signature lazy interface loading] for
                       -- more details.
                       return (setNameLoc n loc)
@@ -221,7 +229,7 @@ newTopSrcBinder (L loc rdr_name)
                         -- ToDo: more helpful error messages
                       ; addErr (unknownNameErr (pprNonVarNameSpace
                             (occNameSpace (rdrNameOcc rdr_name))) rdr_name)
-                      ; return (mkUnboundName rdr_name)
+                      ; return (mkUnboundNameRdr rdr_name)
                       }
                 }
             Nothing ->
@@ -296,7 +304,7 @@ lookupTopBndrRn_maybe rdr_name
            -- See Note [Type and class operator definitions]
           let occ = rdrNameOcc rdr_name
         ; when (isTcOcc occ && isSymOcc occ)
-               (do { op_ok <- xoptM Opt_TypeOperators
+               (do { op_ok <- xoptM LangExt.TypeOperators
                    ; unless op_ok (addErr (opDeclErr rdr_name)) })
 
         ; env <- getGlobalRdrEnv
@@ -365,26 +373,26 @@ lookupExactOcc_either name
            gres -> return (Left (sameNameErr gres))   -- Ugh!  See Note [Template Haskell ambiguity]
        }
   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") ])
+    exact_nm_err = hang (text "The exact Name" <+> quotes (ppr name) <+> ptext (sLit "is not in scope"))
+                      2 (vcat [ text "Probable cause: you used a unique Template Haskell name (NameU), "
+                              , text "perhaps via newName, but did not bind it"
+                              , text "If that's it, then -ddump-splices might be useful" ])
 
 sameNameErr :: [GlobalRdrElt] -> MsgDoc
 sameNameErr [] = panic "addSameNameErr: empty list"
 sameNameErr gres@(_ : _)
-  = hang (ptext (sLit "Same exact name in multiple name-spaces:"))
+  = hang (text "Same exact name in multiple name-spaces:")
        2 (vcat (map pp_one sorted_names) $$ th_hint)
   where
     sorted_names = sortWith nameSrcLoc (map gre_name gres)
     pp_one name
       = hang (pprNameSpace (occNameSpace (getOccName name))
               <+> quotes (ppr name) <> comma)
-           2 (ptext (sLit "declared at:") <+> ppr (nameSrcLoc name))
+           2 (text "declared at:" <+> ppr (nameSrcLoc name))
 
-    th_hint = vcat [ ptext (sLit "Probable cause: you bound a unique Template Haskell name (NameU),")
-                   , ptext (sLit "perhaps via newName, in different name-spaces.")
-                   , ptext (sLit "If that's it, then -ddump-splices might be useful") ]
+    th_hint = vcat [ text "Probable cause: you bound a unique Template Haskell name (NameU),"
+                   , text "perhaps via newName, in different name-spaces."
+                   , text "If that's it, then -ddump-splices might be useful" ]
 
 
 -----------------------------------------------
@@ -409,13 +417,17 @@ lookupInstDeclBndr cls what rdr
                 -- In an instance decl you aren't allowed
                 -- to use a qualified name for the method
                 -- (Although it'd make perfect sense.)
-       ; lookupSubBndrOcc False -- False => we don't give deprecated
+       ; mb_name <- lookupSubBndrOcc
+                          False -- False => we don't give deprecated
                                 -- warnings when a deprecated class
                                 -- method is defined. We only warn
                                 -- when it's used
-                          (ParentIs cls) doc rdr }
+                          cls doc rdr
+       ; case mb_name of
+           Left err -> do { addErr err; return (mkUnboundNameRdr rdr) }
+           Right nm -> return nm }
   where
-    doc = what <+> ptext (sLit "of class") <+> quotes (ppr cls)
+    doc = what <+> text "of class" <+> quotes (ppr cls)
 
 
 -----------------------------------------------
@@ -423,12 +435,12 @@ lookupFamInstName :: Maybe Name -> Located RdrName -> RnM (Located Name)
 -- Used for TyData and TySynonym family instances only,
 -- See Note [Family instance binders]
 lookupFamInstName (Just cls) tc_rdr  -- Associated type; c.f RnBinds.rnMethodBind
-  = wrapLocM (lookupInstDeclBndr cls (ptext (sLit "associated type"))) tc_rdr
+  = wrapLocM (lookupInstDeclBndr cls (text "associated type")) tc_rdr
 lookupFamInstName Nothing tc_rdr     -- Family instance; tc_rdr is an *occurrence*
   = lookupLocatedOccRn tc_rdr
 
 -----------------------------------------------
-lookupConstructorFields :: Name -> RnM [Name]
+lookupConstructorFields :: Name -> RnM [FieldLabel]
 -- Look up the fields of a given constructor
 --   *  For constructors from this module, use the record field env,
 --      which is itself gathered from the (as yet un-typechecked)
@@ -441,10 +453,12 @@ lookupConstructorFields :: Name -> RnM [Name]
 lookupConstructorFields con_name
   = do  { this_mod <- getModule
         ; if nameIsLocalOrFrom this_mod con_name then
-          do { RecFields field_env _ <- getRecFieldEnv
+          do { field_env <- getRecFieldEnv
+             ; traceTc "lookupCF" (ppr con_name $$ ppr (lookupNameEnv field_env con_name) $$ ppr field_env)
              ; return (lookupNameEnv field_env con_name `orElse` []) }
           else
           do { con <- tcLookupDataCon con_name
+             ; traceTc "lookupCF 2" (ppr con)
              ; return (dataConFieldLabels con) } }
 
 -----------------------------------------------
@@ -460,56 +474,76 @@ lookupConstructorFields con_name
 -- unambiguous because there is only one field id 'fld' in scope.
 -- But currently it's rejected.
 
+lookupRecFieldOcc :: Maybe Name  -- Nothing    => just look it up as usual
+                                 -- Just tycon => use tycon to disambiguate
+                  -> SDoc -> RdrName
+                  -> RnM Name
+lookupRecFieldOcc parent doc rdr_name
+  | Just tc_name <- parent
+  = do { mb_name <- lookupSubBndrOcc True tc_name doc rdr_name
+       ; case mb_name of
+           Left err -> do { addErr err; return (mkUnboundNameRdr rdr_name) }
+           Right n  -> return n }
+
+  | otherwise
+  = lookupGlobalOccRn rdr_name
+
 lookupSubBndrOcc :: Bool
-                 -> Parent  -- NoParent   => just look it up as usual
-                            -- ParentIs p => use p to disambiguate
-                 -> SDoc -> RdrName
-                 -> RnM Name
-lookupSubBndrOcc warnIfDeprec parent doc rdr_name
+                 -> Name     -- Parent
+                 -> SDoc
+                 -> RdrName
+                 -> RnM (Either MsgDoc Name)
+-- Find all the things the rdr-name maps to
+-- and pick the one with the right parent namep
+lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name
   | Just n <- isExact_maybe rdr_name   -- This happens in derived code
-  = lookupExactOcc n
+  = do { n <- lookupExactOcc n
+       ; return (Right n) }
 
   | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
-  = lookupOrig rdr_mod rdr_occ
+  = do { n <- lookupOrig rdr_mod rdr_occ
+       ; return (Right n) }
+
+  | isUnboundName the_parent
+        -- Avoid an error cascade from malformed decls:
+        --   instance Int where { foo = e }
+        -- We have already generated an error in rnLHsInstDecl
+  = return (Right (mkUnboundNameRdr rdr_name))
 
-  | otherwise   -- Find all the things the rdr-name maps to
-  = do  {       -- and pick the one with the right parent namep
-          env <- getGlobalRdrEnv
-        ; case lookupSubBndrGREs env parent rdr_name of
+  | otherwise
+  = do { env <- getGlobalRdrEnv
+       ; let gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name)
                 -- NB: lookupGlobalRdrEnv, not lookupGRE_RdrName!
                 --     The latter does pickGREs, but we want to allow 'x'
                 --     even if only 'M.x' is in scope
-            [gre] -> do { addUsedRdrName warnIfDeprec gre (used_rdr_name gre)
-                          -- Add a usage; this is an *occurrence* site
-                        ; return (gre_name gre) }
-            []    -> do { addErr (unknownSubordinateErr doc rdr_name)
-                        ; return (mkUnboundName rdr_name) }
-            gres  -> do { addNameClashErrRn rdr_name gres
-                        ; return (gre_name (head gres)) } }
+       ; traceRn (text "lookupSubBndrOcc" <+> vcat [ppr the_parent, ppr rdr_name, ppr gres, ppr (pick_gres rdr_name gres)])
+       ; case pick_gres rdr_name gres of
+            (gre:_) -> do { addUsedGRE warn_if_deprec gre
+                            -- Add a usage; this is an *occurrence* site
+                            -- Note [Usage for sub-bndrs]
+                          ; return (Right (gre_name gre)) }
+                 -- If there is more than one local GRE for the
+                 -- same OccName 'f', that will be reported separately
+                 -- as a duplicate top-level binding for 'f'
+            [] -> do { ns <- lookupQualifiedNameGHCi rdr_name
+                     ; case ns of
+                         (n:_) -> return (Right n)  -- Unlikely to be more than one...?
+                         [] -> return (Left (unknownSubordinateErr doc rdr_name))
+    } }
   where
-    -- Note [Usage for sub-bndrs]
-    used_rdr_name gre
-      | isQual rdr_name = rdr_name
-      | otherwise       = greUsedRdrName gre
-
-lookupSubBndrGREs :: GlobalRdrEnv -> Parent -> RdrName -> [GlobalRdrElt]
--- If Parent = NoParent, just do a normal lookup
--- If Parent = Parent p then find all GREs that
---   (a) have parent p
---   (b) for Unqual, are in scope qualified or unqualified
---       for Qual, are in scope with that qualification
-lookupSubBndrGREs env parent rdr_name
-  = case parent of
-      NoParent   -> pickGREs rdr_name gres
-      ParentIs p
-        | isUnqual rdr_name -> filter (parent_is p) gres
-        | otherwise         -> filter (parent_is p) (pickGREs rdr_name gres)
-
-  where
-    gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name)
-
-    parent_is p (GRE { gre_par = ParentIs p' }) = p == p'
-    parent_is _ _                               = False
+    -- If Parent = NoParent, just do a normal lookup
+    -- If Parent = Parent p then find all GREs that
+    --   (a) have parent p
+    --   (b) for Unqual, are in scope qualified or unqualified
+    --       for Qual, are in scope with that qualification
+    pick_gres rdr_name gres
+      | isUnqual rdr_name = filter right_parent gres
+      | otherwise         = filter right_parent (pickGREs rdr_name gres)
+
+    right_parent (GRE { gre_par = p })
+      | ParentIs parent <- p               = parent == the_parent
+      | FldParent { par_is = parent } <- p = parent == the_parent
+      | otherwise                          = False
 
 {-
 Note [Family instance binders]
@@ -651,6 +685,9 @@ getLookupOccRn
   = do local_env <- getLocalRdrEnv
        return (lookupLocalRdrOcc local_env . nameOccName)
 
+mkUnboundNameRdr :: RdrName -> Name
+mkUnboundNameRdr rdr = mkUnboundName (rdrNameOcc rdr)
+
 lookupLocatedOccRn :: Located RdrName -> RnM (Located Name)
 lookupLocatedOccRn = wrapLocM lookupOccRn
 
@@ -677,10 +714,13 @@ lookupOccRn rdr_name
 lookupKindOccRn :: RdrName -> RnM Name
 -- Looking up a name occurring in a kind
 lookupKindOccRn rdr_name
-  = do { mb_name <- lookupOccRn_maybe rdr_name
-       ; case mb_name of
-           Just name -> return name
-           Nothing   -> reportUnboundName rdr_name  }
+  = do { typeintype <- xoptM LangExt.TypeInType
+       ; if | typeintype           -> lookupTypeOccRn rdr_name
+      -- With -XNoTypeInType, treat any usage of * in kinds as in scope
+      -- this is a dirty hack, but then again so was the old * kind.
+            | is_star rdr_name     -> return starKindTyConName
+            | is_uni_star rdr_name -> return unicodeStarKindTyConName
+            | otherwise            -> lookupOccRn rdr_name }
 
 -- lookupPromotedOccRn looks up an optionally promoted RdrName.
 lookupTypeOccRn :: RdrName -> RnM Name
@@ -689,20 +729,22 @@ lookupTypeOccRn rdr_name
   = do { mb_name <- lookupOccRn_maybe rdr_name
        ; case mb_name of {
              Just name -> return name ;
-             Nothing   -> lookup_demoted rdr_name } }
+             Nothing   -> do { dflags <- getDynFlags
+                             ; lookup_demoted rdr_name dflags } } }
 
-lookup_demoted :: RdrName -> RnM Name
-lookup_demoted rdr_name
+lookup_demoted :: RdrName -> DynFlags -> RnM Name
+lookup_demoted rdr_name dflags
   | Just demoted_rdr <- demoteRdrName rdr_name
     -- Maybe it's the name of a *data* constructor
-  = do { data_kinds <- xoptM Opt_DataKinds
+  = do { data_kinds <- xoptM LangExt.DataKinds
        ; mb_demoted_name <- lookupOccRn_maybe demoted_rdr
        ; case mb_demoted_name of
-           Nothing -> reportUnboundName rdr_name
+           Nothing -> unboundNameX WL_Any rdr_name star_info
            Just demoted_name
              | data_kinds ->
              do { whenWOptM Opt_WarnUntickedPromotedConstructors $
-                  addWarn (untickedPromConstrWarn demoted_name)
+                  addWarn (Reason Opt_WarnUntickedPromotedConstructors)
+                          (untickedPromConstrWarn demoted_name)
                 ; return demoted_name }
              | otherwise  -> unboundNameX WL_Any rdr_name suggest_dk }
 
@@ -710,7 +752,7 @@ lookup_demoted rdr_name
   = reportUnboundName rdr_name
 
   where
-    suggest_dk = ptext (sLit "A data constructor of that name is in scope; did you mean DataKinds?")
+    suggest_dk = text "A data constructor of that name is in scope; did you mean DataKinds?"
     untickedPromConstrWarn name =
       text "Unticked promoted constructor" <> colon <+> quotes (ppr name) <> dot
       $$
@@ -719,6 +761,20 @@ lookup_demoted rdr_name
            , text "instead of"
            , quotes (ppr name) <> dot ]
 
+    star_info
+      | is_star rdr_name || is_uni_star rdr_name
+      = if xopt LangExt.TypeInType dflags
+        then text "NB: With TypeInType, you must import" <+>
+             ppr rdr_name <+> text "from Data.Kind"
+        else empty
+
+      | otherwise
+      = empty
+
+is_star, is_uni_star :: RdrName -> Bool
+is_star     = (fsLit "*" ==) . occNameFS . rdrNameOcc
+is_uni_star = (fsLit "★" ==) . occNameFS . rdrNameOcc
+
 {-
 Note [Demotion]
 ~~~~~~~~~~~~~~~
@@ -760,16 +816,33 @@ lookupOccRn_maybe rdr_name
        ; case lookupLocalRdrEnv local_env rdr_name of {
           Just name -> return (Just name) ;
           Nothing   -> do
-       { mb_name <- lookupGlobalOccRn_maybe rdr_name
-       ; case mb_name of {
-                Just name  -> return (Just name) ;
-                Nothing -> do
-       { ns <- lookupQualifiedNameGHCi rdr_name
+       ; lookupGlobalOccRn_maybe rdr_name } }
+
+lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name)
+-- Looks up a RdrName occurrence in the top-level
+--   environment, including using lookupQualifiedNameGHCi
+--   for the GHCi case
+-- No filter function; does not report an error on failure
+-- Uses addUsedRdrName to record use and deprecations
+lookupGlobalOccRn_maybe rdr_name
+  | Just n <- isExact_maybe rdr_name   -- This happens in derived code
+  = do { n' <- lookupExactOcc n; return (Just n') }
+
+  | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
+  = do { n <- lookupOrig rdr_mod rdr_occ
+       ; return (Just n) }
+
+  | otherwise
+  = do  { mb_gre <- lookupGreRn_maybe rdr_name
+        ; case mb_gre of {
+            Just gre -> return (Just (gre_name gre)) ;
+            Nothing  ->
+     do { ns <- lookupQualifiedNameGHCi rdr_name
                       -- This test is not expensive,
                       -- and only happens for failed lookups
        ; case ns of
            (n:_) -> return (Just n)  -- Unlikely to be more than one...?
-           []    -> return Nothing } } } } }
+           []    -> return Nothing } } }
 
 lookupGlobalOccRn :: RdrName -> RnM Name
 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
@@ -781,6 +854,27 @@ lookupGlobalOccRn rdr_name
            Nothing -> do { traceRn (text "lookupGlobalOccRn" <+> ppr rdr_name)
                          ; unboundName WL_Global rdr_name } }
 
+-- like lookupGlobalOccRn but suggests adding 'type' keyword
+-- to export type constructors mistaken for data constructors
+lookupGlobalOccRnExport :: RdrName -> RnM Name
+lookupGlobalOccRnExport rdr_name
+  = do { mb_name <- lookupGlobalOccRn_maybe rdr_name
+       ; case mb_name of
+           Just n  -> return n
+           Nothing -> do { env <- getGlobalRdrEnv
+                         ; let tycon = setOccNameSpace tcClsName (rdrNameOcc rdr_name)
+                               msg = case lookupOccEnv env tycon of
+                                   Just (gre : _) -> make_msg gre
+                                   _              -> Outputable.empty
+                               make_msg gre = hang
+                                   (hsep [text "Note: use",
+                                       quotes (text "type"),
+                                       text "keyword to export type constructor",
+                                       quotes (ppr (gre_name gre))])
+                                   2 (vcat [pprNameProvenance gre,
+                                       text "(requires TypeOperators extension)"])
+                         ; unboundNameX WL_Global rdr_name msg } }
+
 lookupInfoOccRn :: RdrName -> RnM [Name]
 -- lookupInfoOccRn is intended for use in GHCi's ":info" command
 -- It finds all the GREs that RdrName could mean, not complaining
@@ -800,22 +894,64 @@ lookupInfoOccRn rdr_name
        ; qual_ns <- lookupQualifiedNameGHCi rdr_name
        ; return (ns ++ (qual_ns `minusList` ns)) }
 
-lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name)
--- No filter function; does not report an error on failure
+-- | Like 'lookupOccRn_maybe', but with a more informative result if
+-- the 'RdrName' happens to be a record selector:
+--
+--   * Nothing         -> name not in scope (no error reported)
+--   * Just (Left x)   -> name uniquely refers to x,
+--                        or there is a name clash (reported)
+--   * Just (Right xs) -> name refers to one or more record selectors;
+--                        if overload_ok was False, this list will be
+--                        a singleton.
+lookupOccRn_overloaded  :: Bool -> RdrName -> RnM (Maybe (Either Name [FieldOcc Name]))
+lookupOccRn_overloaded overload_ok rdr_name
+  = do { local_env <- getLocalRdrEnv
+       ; case lookupLocalRdrEnv local_env rdr_name of {
+          Just name -> return (Just (Left name)) ;
+          Nothing   -> do
+       { mb_name <- lookupGlobalOccRn_overloaded overload_ok rdr_name
+       ; case mb_name of {
+           Just name -> return (Just name) ;
+           Nothing   -> do
+       { ns <- lookupQualifiedNameGHCi rdr_name
+                      -- This test is not expensive,
+                      -- and only happens for failed lookups
+       ; case ns of
+           (n:_) -> return $ Just $ Left n  -- Unlikely to be more than one...?
+           []    -> return Nothing  } } } } }
 
-lookupGlobalOccRn_maybe rdr_name
+lookupGlobalOccRn_overloaded :: Bool -> RdrName -> RnM (Maybe (Either Name [FieldOcc Name]))
+lookupGlobalOccRn_overloaded overload_ok rdr_name
   | Just n <- isExact_maybe rdr_name   -- This happens in derived code
-  = do { n' <- lookupExactOcc n; return (Just n') }
+  = do { n' <- lookupExactOcc n; return (Just (Left n')) }
 
   | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
   = do { n <- lookupOrig rdr_mod rdr_occ
-       ; return (Just n) }
+       ; return (Just (Left n)) }
 
   | otherwise
-  = do  { mb_gre <- lookupGreRn_maybe rdr_name
-        ; case mb_gre of
-                Nothing  -> return Nothing
-                Just gre -> return (Just (gre_name gre)) }
+  = do  { env <- getGlobalRdrEnv
+        ; case lookupGRE_RdrName rdr_name env of
+                []    -> return Nothing
+                [gre] | isRecFldGRE gre
+                         -> do { addUsedGRE True gre
+                               ; let
+                                   fld_occ :: FieldOcc Name
+                                   fld_occ
+                                     = FieldOcc (noLoc rdr_name) (gre_name gre)
+                               ; return (Just (Right [fld_occ])) }
+                      | otherwise
+                         -> do { addUsedGRE True gre
+                               ; return (Just (Left (gre_name gre))) }
+                gres  | all isRecFldGRE gres && overload_ok
+                            -- Don't record usage for ambiguous selectors
+                            -- until we know which is meant
+                         -> return
+                             (Just (Right
+                                     (map (FieldOcc (noLoc rdr_name) . gre_name)
+                                           gres)))
+                gres     -> do { addNameClashErrRn rdr_name gres
+                               ; return (Just (Left (gre_name (head gres)))) } }
 
 
 --------------------------------------------------
@@ -829,11 +965,12 @@ lookupGreRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
 --   Many bindings:       report "ambiguous", return an arbitrary (Just gre)
 -- (This API is a bit strange; lookupGRERn2_maybe is simpler.
 --  But it works and I don't want to fiddle too much.)
+-- Uses addUsedRdrName to record use and deprecations
 lookupGreRn_maybe rdr_name
   = do  { env <- getGlobalRdrEnv
         ; case lookupGRE_RdrName rdr_name env of
             []    -> return Nothing
-            [gre] -> do { addUsedRdrName True gre rdr_name
+            [gre] -> do { addUsedGRE True gre
                         ; return (Just gre) }
             gres  -> do { addNameClashErrRn rdr_name gres
                         ; traceRn (text "name clash" <+> (ppr rdr_name $$ ppr gres $$ ppr env))
@@ -844,12 +981,13 @@ lookupGreRn2_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
 --   Exactly one binding: record it as "used",   return (Just gre)
 --   No bindings:         report "not in scope", return Nothing
 --   Many bindings:       report "ambiguous",    return Nothing
+-- Uses addUsedRdrName to record use and deprecations
 lookupGreRn2_maybe rdr_name
   = do  { env <- getGlobalRdrEnv
         ; case lookupGRE_RdrName rdr_name env of
             []    -> do { _ <- unboundName WL_Global rdr_name
                         ; return Nothing }
-            [gre] -> do { addUsedRdrName True gre rdr_name
+            [gre] -> do { addUsedGRE True gre
                         ; return (Just gre) }
             gres  -> do { addNameClashErrRn rdr_name gres
                         ; traceRn (text "name clash" <+> (ppr rdr_name $$ ppr gres $$ ppr env))
@@ -858,14 +996,15 @@ lookupGreRn2_maybe rdr_name
 lookupGreAvailRn :: RdrName -> RnM (Name, AvailInfo)
 -- Used in export lists
 -- If not found or ambiguous, add error message, and fake with UnboundName
+-- Uses addUsedRdrName to record use and deprecations
 lookupGreAvailRn rdr_name
   = do  { mb_gre <- lookupGreRn2_maybe rdr_name
         ; case mb_gre of {
             Just gre -> return (gre_name gre, availFromGRE gre) ;
             Nothing  ->
     do  { traceRn (text "lookupGreRn" <+> ppr rdr_name)
-        ; let name = mkUnboundName rdr_name
-        ; return (name, Avail name) } } }
+        ; let name = mkUnboundNameRdr rdr_name
+        ; return (name, avail name) } } }
 
 {-
 *********************************************************
@@ -885,34 +1024,40 @@ Note [Handling of deprecations]
   even use a deprecated thing in the defn of a non-deprecated thing,
   when changing a module's interface.
 
-* addUsedRdrNames: we do not report deprecations for sub-binders:
+* addUsedGREs: we do not report deprecations for sub-binders:
      - the ".." completion for records
      - the ".." in an export item 'T(..)'
      - the things exported by a module export 'module M'
 -}
 
-addUsedRdrName :: Bool -> GlobalRdrElt -> RdrName -> RnM ()
--- Record usage of imported RdrNames
-addUsedRdrName warn_if_deprec gre rdr
-  = do { unless (isLocalGRE gre) $
+addUsedDataCons :: GlobalRdrEnv -> TyCon -> RnM ()
+-- Remember use of in-scope data constructors (Trac #7969)
+addUsedDataCons rdr_env tycon
+  = addUsedGREs [ gre
+                | dc <- tyConDataCons tycon
+                , gre : _ <- [lookupGRE_Name rdr_env (dataConName dc) ] ]
+
+addUsedGRE :: Bool -> GlobalRdrElt -> RnM ()
+-- Called for both local and imported things
+-- Add usage *and* warn if deprecated
+addUsedGRE warn_if_deprec gre
+  = do { when warn_if_deprec (warnIfDeprecated gre)
+       ; unless (isLocalGRE gre) $
          do { env <- getGblEnv
-            ; traceRn (text "addUsedRdrName 1" <+> ppr gre)
-            ; updMutVar (tcg_used_rdrnames env)
-                        (\s -> Set.insert rdr s) }
-
-       ; when warn_if_deprec $
-         warnIfDeprecated gre }
+            ; traceRn (text "addUsedGRE" <+> ppr gre)
+            ; updMutVar (tcg_used_gres env) (gre :) } }
 
-addUsedRdrNames :: [RdrName] -> RnM ()
--- Record used sub-binders
--- We don't check for imported-ness here, because it's inconvenient
--- and not stritly necessary.
+addUsedGREs :: [GlobalRdrElt] -> RnM ()
+-- Record uses of any *imported* GREs
+-- Used for recording used sub-bndrs
 -- NB: no call to warnIfDeprecated; see Note [Handling of deprecations]
-addUsedRdrNames rdrs
-  = do { env <- getGblEnv
-       ; traceRn (text "addUsedRdrName 2" <+> ppr rdrs)
-       ; updMutVar (tcg_used_rdrnames env)
-                   (\s -> foldr Set.insert s rdrs) }
+addUsedGREs gres
+  | null imp_gres = return ()
+  | otherwise     = do { env <- getGblEnv
+                       ; traceRn (text "addUsedGREs" <+> ppr imp_gres)
+                       ; updMutVar (tcg_used_gres env) (imp_gres ++) }
+  where
+    imp_gres = filterOut isLocalGRE gres
 
 warnIfDeprecated :: GlobalRdrElt -> RnM ()
 warnIfDeprecated gre@(GRE { gre_name = name, gre_imp = iss })
@@ -924,32 +1069,36 @@ warnIfDeprecated gre@(GRE { gre_name = name, gre_imp = iss })
                    -- See Note [Handling of deprecations]
          do { iface <- loadInterfaceForName doc name
             ; case lookupImpDeprec iface gre of
-                Just txt -> addWarn (mk_msg imp_spec txt)
+                Just txt -> addWarn (Reason Opt_WarnWarningsDeprecations)
+                                   (mk_msg imp_spec txt)
                 Nothing  -> return () } }
   | otherwise
   = return ()
   where
+    occ = greOccName gre
     name_mod = ASSERT2( isExternalName name, ppr name ) nameModule name
-    doc = ptext (sLit "The name") <+> quotes (ppr name) <+> ptext (sLit "is mentioned explicitly")
+    doc = text "The name" <+> quotes (ppr occ) <+> ptext (sLit "is mentioned explicitly")
 
     mk_msg imp_spec txt
-      = sep [ sep [ ptext (sLit "In the use of")
-                    <+> pprNonVarNameSpace (occNameSpace (nameOccName name))
-                    <+> quotes (ppr name)
+      = sep [ sep [ text "In the use of"
+                    <+> pprNonVarNameSpace (occNameSpace occ)
+                    <+> quotes (ppr occ)
                   , parens imp_msg <> colon ]
             , ppr txt ]
       where
         imp_mod  = importSpecModule imp_spec
-        imp_msg  = ptext (sLit "imported from") <+> ppr imp_mod <> extra
+        imp_msg  = text "imported from" <+> ppr imp_mod <> extra
         extra | imp_mod == moduleName name_mod = Outputable.empty
-              | otherwise = ptext (sLit ", but defined in") <+> ppr name_mod
+              | otherwise = text ", but defined in" <+> ppr name_mod
 
 lookupImpDeprec :: ModIface -> GlobalRdrElt -> Maybe WarningTxt
 lookupImpDeprec iface gre
-  = mi_warn_fn iface (gre_name gre) `mplus`  -- Bleat if the thing,
+  = mi_warn_fn iface (greOccName gre) `mplus`  -- Bleat if the thing,
     case gre_par gre of                      -- or its parent, is warn'd
-       ParentIs p -> mi_warn_fn iface p
-       NoParent   -> Nothing
+       ParentIs  p              -> mi_warn_fn iface (nameOccName p)
+       FldParent { par_is = p } -> mi_warn_fn iface (nameOccName p)
+       NoParent                 -> Nothing
+       PatternSynonym           -> Nothing
 
 {-
 Note [Used names with interface not loaded]
@@ -1022,9 +1171,10 @@ lookupQualifiedNameGHCi rdr_name
                         ; return [] } }
 
       | otherwise
-      = return []
+      = do { traceRn (text "lookupQualifedNameGHCi: off" <+> ppr rdr_name)
+           ; return [] }
 
-    doc = ptext (sLit "Need to find") <+> ppr rdr_name
+    doc = text "Need to find" <+> ppr rdr_name
 
 {-
 Note [Looking up signature names]
@@ -1076,7 +1226,8 @@ data HsSigCtxt
                              -- See Note [Signatures for top level things]
   | LocalBindCtxt NameSet    -- In a local binding, binding these names
   | ClsDeclCtxt   Name       -- Class decl for this class
-  | InstDeclCtxt  Name       -- Intsance decl for this class
+  | InstDeclCtxt  NameSet    -- Instance decl whose user-written method
+                             -- bindings are for these methods
   | HsBootCtxt               -- Top level of a hs-boot file
   | RoleAnnotCtxt NameSet    -- A role annotation, with the names of all types
                              -- in the group
@@ -1095,7 +1246,7 @@ lookupSigCtxtOccRn ctxt what
   = wrapLocM $ \ rdr_name ->
     do { mb_name <- lookupBindGroupOcc ctxt what rdr_name
        ; case mb_name of
-           Left err   -> do { addErr err; return (mkUnboundName rdr_name) }
+           Left err   -> do { addErr err; return (mkUnboundNameRdr rdr_name) }
            Right name -> return name }
 
 lookupBindGroupOcc :: HsSigCtxt
@@ -1124,19 +1275,12 @@ lookupBindGroupOcc ctxt what rdr_name
       RoleAnnotCtxt ns -> lookup_top (`elemNameSet` ns)
       LocalBindCtxt ns -> lookup_group ns
       ClsDeclCtxt  cls -> lookup_cls_op cls
-      InstDeclCtxt cls -> lookup_cls_op cls
+      InstDeclCtxt ns  -> lookup_top (`elemNameSet` ns)
   where
     lookup_cls_op cls
-      = do { env <- getGlobalRdrEnv
-           ; let gres = lookupSubBndrGREs env (ParentIs cls) rdr_name
-           ; case gres of
-               []      -> return (Left (unknownSubordinateErr doc rdr_name))
-               (gre:_) -> return (Right (gre_name gre)) }
-                        -- If there is more than one local GRE for the
-                        -- same OccName 'f', that will be reported separately
-                        -- as a duplicate top-level binding for 'f'
+      = lookupSubBndrOcc True cls doc rdr_name
       where
-        doc = ptext (sLit "method of class") <+> quotes (ppr cls)
+        doc = text "method of class" <+> quotes (ppr cls)
 
     lookup_top keep_me
       = do { env <- getGlobalRdrEnv
@@ -1155,17 +1299,17 @@ lookupBindGroupOcc ctxt what rdr_name
                Nothing                         -> bale_out_with Outputable.empty }
 
     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")]
+        = return (Left (sep [ text "The" <+> what
+                                <+> text "for" <+> quotes (ppr rdr_name)
+                           , nest 2 $ text "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")
+    local_msg = parens $ text "The"  <+> what <+> ptext (sLit "must be given where")
+                           <+> quotes (ppr rdr_name) <+> text "is declared"
 
 
 ---------------
-lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [Name]
+lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [(RdrName, Name)]
 -- GHC extension: look up both the tycon and data con or variable.
 -- Used for top-level fixity signatures and deprecations.
 -- Complain if neither is in scope.
@@ -1176,7 +1320,8 @@ lookupLocalTcNames ctxt what rdr_name
        ; when (null names) $ addErr (head errs) -- Bleat about one only
        ; return names }
   where
-    lookup = lookupBindGroupOcc ctxt what
+    lookup rdr = do { name <- lookupBindGroupOcc ctxt what rdr
+                    ; return (fmap ((,) rdr) name) }
 
 dataTcOccs :: RdrName -> [RdrName]
 -- Return both the given name and the same name promoted to the TcClsName
@@ -1279,9 +1424,26 @@ lookupFixity is a bit strange.
 -}
 
 lookupFixityRn :: Name -> RnM Fixity
-lookupFixityRn name
+lookupFixityRn name = lookupFixityRn' name (nameOccName name)
+
+lookupFixityRn' :: Name -> OccName -> RnM Fixity
+lookupFixityRn' name = fmap snd . lookupFixityRn_help' name
+
+-- | 'lookupFixityRn_help' returns @(True, fixity)@ if it finds a 'Fixity'
+-- in a local environment or from an interface file. Otherwise, it returns
+-- @(False, fixity)@ (e.g., for unbound 'Name's or 'Name's without
+-- user-supplied fixity declarations).
+lookupFixityRn_help :: Name
+                    -> RnM (Bool, Fixity)
+lookupFixityRn_help name =
+    lookupFixityRn_help' name (nameOccName name)
+
+lookupFixityRn_help' :: Name
+                     -> OccName
+                     -> RnM (Bool, Fixity)
+lookupFixityRn_help' name occ
   | isUnboundName name
-  = return (Fixity minPrecedence InfixL)
+  = return (False, Fixity (show minPrecedence) minPrecedence InfixL)
     -- Minimise errors from ubound names; eg
     --    a>0 `foo` b>0
     -- where 'foo' is not in scope, should not give an error (Trac #7937)
@@ -1289,14 +1451,14 @@ lookupFixityRn name
   | otherwise
   = do { local_fix_env <- getFixityEnv
        ; case lookupNameEnv local_fix_env name of {
-           Just (FixItem _ fix) -> return fix ;
+           Just (FixItem _ fix) -> return (True, fix) ;
            Nothing ->
 
     do { this_mod <- getModule
        ; if nameIsLocalOrFrom this_mod name
                -- Local (and interactive) names are all in the
                -- fixity env, and don't have entries in the HPT
-         then return defaultFixity
+         then return (False, defaultFixity)
          else lookup_imported } } }
   where
     lookup_imported
@@ -1317,16 +1479,62 @@ lookupFixityRn name
       -- loadInterfaceForName will find B.hi even if B is a hidden module,
       -- and that's what we want.
       = do { iface <- loadInterfaceForName doc name
-           ; traceRn (text "lookupFixityRn: looking up name in iface cache and found:" <+>
-                      vcat [ppr name, ppr $ mi_fix_fn iface (nameOccName name)])
-           ; return (mi_fix_fn iface (nameOccName name)) }
-
-    doc = ptext (sLit "Checking fixity for") <+> ppr name
+           ; let mb_fix = mi_fix_fn iface occ
+           ; let msg = case mb_fix of
+                            Nothing ->
+                                  text "looking up name" <+> ppr name
+                              <+> text "in iface, but found no fixity for it."
+                              <+> text "Using default fixity instead."
+                            Just f ->
+                                  text "looking up name in iface and found:"
+                              <+> vcat [ppr name, ppr f]
+           ; traceRn (text "lookupFixityRn_either:" <+> msg)
+           ; return (maybe (False, defaultFixity) (\f -> (True, f)) mb_fix)  }
+
+    doc = text "Checking fixity for" <+> ppr name
 
 ---------------
 lookupTyFixityRn :: Located Name -> RnM Fixity
 lookupTyFixityRn (L _ n) = lookupFixityRn n
 
+-- | Look up the fixity of a (possibly ambiguous) occurrence of a record field
+-- selector.  We use 'lookupFixityRn'' so that we can specifiy the 'OccName' as
+-- the field label, which might be different to the 'OccName' of the selector
+-- 'Name' if @DuplicateRecordFields@ is in use (Trac #1173). If there are
+-- multiple possible selectors with different fixities, generate an error.
+lookupFieldFixityRn :: AmbiguousFieldOcc Name -> RnM Fixity
+lookupFieldFixityRn (Unambiguous (L _ rdr) n)
+  = lookupFixityRn' n (rdrNameOcc rdr)
+lookupFieldFixityRn (Ambiguous   (L _ rdr) _) = get_ambiguous_fixity rdr
+  where
+    get_ambiguous_fixity :: RdrName -> RnM Fixity
+    get_ambiguous_fixity rdr_name = do
+      traceRn $ text "get_ambiguous_fixity" <+> ppr rdr_name
+      rdr_env <- getGlobalRdrEnv
+      let elts =  lookupGRE_RdrName rdr_name rdr_env
+
+      fixities <- groupBy ((==) `on` snd) . zip elts
+                  <$> mapM lookup_gre_fixity elts
+
+      case fixities of
+        -- There should always be at least one fixity.
+        -- Something's very wrong if there are no fixity candidates, so panic
+        [] -> panic "get_ambiguous_fixity: no candidates for a given RdrName"
+        [ (_, fix):_ ] -> return fix
+        ambigs -> addErr (ambiguous_fixity_err rdr_name ambigs)
+                  >> return (Fixity(show minPrecedence) minPrecedence InfixL)
+
+    lookup_gre_fixity gre = lookupFixityRn' (gre_name gre) (greOccName gre)
+
+    ambiguous_fixity_err rn ambigs
+      = vcat [ text "Ambiguous fixity for record field" <+> quotes (ppr rn)
+             , hang (text "Conflicts: ") 2 . vcat .
+               map format_ambig $ concat ambigs ]
+
+    format_ambig (elt, fix) = hang (ppr fix)
+                                 2 (pprNameProvenance elt)
+
+
 {-
 ************************************************************************
 *                                                                      *
@@ -1373,32 +1581,34 @@ lookupIfThenElse :: RnM (Maybe (SyntaxExpr Name), FreeVars)
 -- case we desugar directly rather than calling an existing function
 -- Hence the (Maybe (SyntaxExpr Name)) return type
 lookupIfThenElse
-  = do { rebind <- xoptM Opt_RebindableSyntax
-       ; if not rebind
+  = do { rebindable_on <- xoptM LangExt.RebindableSyntax
+       ; if not rebindable_on
          then return (Nothing, emptyFVs)
          else do { ite <- lookupOccRn (mkVarUnqual (fsLit "ifThenElse"))
-                 ; return (Just (HsVar ite), unitFV ite) } }
+                 ; return ( Just (mkRnSyntaxExpr ite)
+                          , unitFV ite ) } }
 
 lookupSyntaxName :: Name                                -- The standard name
                  -> RnM (SyntaxExpr Name, FreeVars)     -- Possibly a non-standard name
 lookupSyntaxName std_name
-  = do { rebindable_on <- xoptM Opt_RebindableSyntax
+  = do { rebindable_on <- xoptM LangExt.RebindableSyntax
        ; if not rebindable_on then
-           return (HsVar std_name, emptyFVs)
+           return (mkRnSyntaxExpr std_name, emptyFVs)
          else
             -- Get the similarly named thing from the local environment
            do { usr_name <- lookupOccRn (mkRdrUnqual (nameOccName std_name))
-              ; return (HsVar usr_name, unitFV usr_name) } }
+              ; return (mkRnSyntaxExpr usr_name, unitFV usr_name) } }
 
 lookupSyntaxNames :: [Name]                          -- Standard names
                   -> RnM ([HsExpr Name], FreeVars)   -- See comments with HsExpr.ReboundNames
+   -- this works with CmdTop, which wants HsExprs, not SyntaxExprs
 lookupSyntaxNames std_names
-  = do { rebindable_on <- xoptM Opt_RebindableSyntax
+  = do { rebindable_on <- xoptM LangExt.RebindableSyntax
        ; if not rebindable_on then
-             return (map HsVar std_names, emptyFVs)
+             return (map (HsVar . noLoc) std_names, emptyFVs)
         else
           do { usr_names <- mapM (lookupOccRn . mkRdrUnqual . nameOccName) std_names
-             ; return (map HsVar usr_names, mkFVs usr_names) } }
+             ; return (map (HsVar . noLoc) usr_names, mkFVs usr_names) } }
 
 {-
 *********************************************************
@@ -1519,7 +1729,7 @@ checkShadowedOccs (global_env,local_env) get_loc_occ ns
     check_shadow n
         | startsWithUnderscore occ = return ()  -- Do not report shadowing for "_x"
                                                 -- See Trac #3262
-        | Just n <- mb_local = complain [ptext (sLit "bound at") <+> ppr (nameSrcLoc n)]
+        | Just n <- mb_local = complain [text "bound at" <+> ppr (nameSrcLoc n)]
         | otherwise = do { gres' <- filterM is_shadowed_gre gres
                          ; complain (map pprNameProvenance gres') }
         where
@@ -1530,24 +1740,19 @@ checkShadowedOccs (global_env,local_env) get_loc_occ ns
                 -- we don't find any GREs that are in scope qualified-only
 
           complain []      = return ()
-          complain pp_locs = addWarnAt loc (shadowedNameWarn occ pp_locs)
+          complain pp_locs = addWarnAt (Reason Opt_WarnNameShadowing)
+                                       loc
+                                       (shadowedNameWarn occ pp_locs)
 
     is_shadowed_gre :: GlobalRdrElt -> RnM Bool
         -- Returns False for record selectors that are shadowed, when
         -- punning or wild-cards are on (cf Trac #2723)
-    is_shadowed_gre gre@(GRE { gre_par = ParentIs _ })
+    is_shadowed_gre gre | isRecFldGRE gre
         = do { dflags <- getDynFlags
-             ; if (xopt Opt_RecordPuns dflags || xopt Opt_RecordWildCards dflags)
-               then do { is_fld <- is_rec_fld gre; return (not is_fld) }
-               else return True }
+             ; return $ not (xopt LangExt.RecordPuns dflags
+                             || xopt LangExt.RecordWildCards dflags) }
     is_shadowed_gre _other = return True
 
-    is_rec_fld gre      -- Return True for record selector ids
-        | isLocalGRE gre = do { RecFields _ fld_set <- getRecFieldEnv
-                              ; return (gre_name gre `elemNameSet` fld_set) }
-        | otherwise      = do { sel_id <- tcLookupField (gre_name gre)
-                              ; return (isRecordSelector sel_id) }
-
 {-
 ************************************************************************
 *                                                                      *
@@ -1576,14 +1781,15 @@ unboundNameX where_look rdr_name extra
           then addErr err
           else do { local_env  <- getLocalRdrEnv
                   ; global_env <- getGlobalRdrEnv
+                  ; impInfo <- getImports
                   ; let suggestions = unknownNameSuggestions_ where_look
-                                         dflags global_env local_env rdr_name
+                                        dflags global_env local_env impInfo rdr_name
                   ; addErr (err $$ suggestions) }
-        ; return (mkUnboundName rdr_name) }
+        ; return (mkUnboundNameRdr rdr_name) }
 
 unknownNameErr :: SDoc -> RdrName -> SDoc
 unknownNameErr what rdr_name
-  = vcat [ hang (ptext (sLit "Not in scope:"))
+  = vcat [ hang (text "Not in scope:")
               2 (what <+> quotes (ppr rdr_name))
          , extra ]
   where
@@ -1594,22 +1800,30 @@ type HowInScope = Either SrcSpan ImpDeclSpec
      -- Left loc    =>  locally bound at loc
      -- Right ispec =>  imported as specified by ispec
 
+
+-- | Called from the typechecker (TcErrors) when we find an unbound variable
 unknownNameSuggestions :: DynFlags
-                       -> GlobalRdrEnv -> LocalRdrEnv
+                       -> GlobalRdrEnv -> LocalRdrEnv -> ImportAvails
                        -> RdrName -> SDoc
--- Called from the typechecker (TcErrors)
--- when we find an unbound variable
 unknownNameSuggestions = unknownNameSuggestions_ WL_Any
 
 unknownNameSuggestions_ :: WhereLooking -> DynFlags
+                       -> GlobalRdrEnv -> LocalRdrEnv -> ImportAvails
+                       -> RdrName -> SDoc
+unknownNameSuggestions_ where_look dflags global_env local_env imports tried_rdr_name =
+    similarNameSuggestions where_look dflags global_env local_env tried_rdr_name $$
+    importSuggestions dflags imports tried_rdr_name
+
+
+similarNameSuggestions :: WhereLooking -> DynFlags
                         -> GlobalRdrEnv -> LocalRdrEnv
                         -> RdrName -> SDoc
-unknownNameSuggestions_ where_look dflags global_env
+similarNameSuggestions where_look dflags global_env
                         local_env tried_rdr_name
   = case suggest of
       []  -> Outputable.empty
       [p] -> perhaps <+> pp_item p
-      ps  -> sep [ perhaps <+> ptext (sLit "one of these:")
+      ps  -> sep [ perhaps <+> text "one of these:"
                  , nest 2 (pprWithCommas pp_item ps) ]
   where
     all_possibilities :: [(String, (RdrName, HowInScope))]
@@ -1619,15 +1833,15 @@ unknownNameSuggestions_ where_look dflags 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")
+    perhaps = text "Perhaps you meant"
 
     pp_item :: (RdrName, HowInScope) -> SDoc
     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))
+                     RealSrcSpan l -> parens (text "line" <+> int (srcSpanStartLine l))
     pp_item (rdr, Right is) = pp_ns rdr <+> quotes (ppr rdr) <+>   -- Imported
-                              parens (ptext (sLit "imported from") <+> ppr (is_mod is))
+                              parens (text "imported from" <+> ppr (is_mod is))
 
     pp_ns :: RdrName -> SDoc
     pp_ns rdr | ns /= tried_ns = pprNameSpace ns
@@ -1718,6 +1932,113 @@ unknownNameSuggestions_ where_look dflags global_env
       = [ (mkRdrQual (is_as ispec) (nameOccName n), Right ispec)
         | i <- is, let ispec = is_decl i, is_qual ispec ]
 
+-- | Generate helpful suggestions if a qualified name Mod.foo is not in scope.
+importSuggestions :: DynFlags -> ImportAvails -> RdrName -> SDoc
+importSuggestions _dflags imports rdr_name
+  | not (isQual rdr_name || isUnqual rdr_name) = Outputable.empty
+  | null interesting_imports
+  , Just name <- mod_name
+  = hsep
+      [ text "No module named"
+      , quotes (ppr name)
+      , text "is imported."
+      ]
+  | is_qualified
+  , null helpful_imports
+  , [(mod,_)] <- interesting_imports
+  = hsep
+      [ text "Module"
+      , quotes (ppr mod)
+      , text "does not export"
+      , quotes (ppr occ_name) <> dot
+      ]
+  | is_qualified
+  , null helpful_imports
+  , mods <- map fst interesting_imports
+  = hsep
+      [ text "Neither"
+      , quotedListWithNor (map ppr mods)
+      , text "exports"
+      , quotes (ppr occ_name) <> dot
+      ]
+  | [(mod,imv)] <- helpful_imports_non_hiding
+  = fsep
+      [ text "Perhaps you want to add"
+      , quotes (ppr occ_name)
+      , text "to the import list"
+      , text "in the import of"
+      , quotes (ppr mod)
+      , parens (ppr (imv_span imv)) <> dot
+      ]
+  | not (null helpful_imports_non_hiding)
+  = fsep
+      [ text "Perhaps you want to add"
+      , quotes (ppr occ_name)
+      , text "to one of these import lists:"
+      ]
+    $$
+    nest 2 (vcat
+        [ quotes (ppr mod) <+> parens (ppr (imv_span imv))
+        | (mod,imv) <- helpful_imports_non_hiding
+        ])
+  | [(mod,imv)] <- helpful_imports_hiding
+  = fsep
+      [ text "Perhaps you want to remove"
+      , quotes (ppr occ_name)
+      , text "from the explicit hiding list"
+      , text "in the import of"
+      , quotes (ppr mod)
+      , parens (ppr (imv_span imv)) <> dot
+      ]
+  | not (null helpful_imports_hiding)
+  = fsep
+      [ text "Perhaps you want to remove"
+      , quotes (ppr occ_name)
+      , text "from the hiding clauses"
+      , text "in one of these imports:"
+      ]
+    $$
+    nest 2 (vcat
+        [ quotes (ppr mod) <+> parens (ppr (imv_span imv))
+        | (mod,imv) <- helpful_imports_hiding
+        ])
+  | otherwise
+  = Outputable.empty
+ where
+  is_qualified = isQual rdr_name
+  (mod_name, occ_name) = case rdr_name of
+    Unqual occ_name        -> (Nothing, occ_name)
+    Qual mod_name occ_name -> (Just mod_name, occ_name)
+    _                      -> error "importSuggestions: dead code"
+
+
+  -- What import statements provide "Mod" at all
+  -- or, if this is an unqualified name, are not qualified imports
+  interesting_imports = [ (mod, imp)
+    | (mod, mod_imports) <- moduleEnvToList (imp_mods imports)
+    , Just imp <- return $ pick mod_imports
+    ]
+
+  -- We want to keep only one for each original module; preferably one with an
+  -- explicit import list (for no particularly good reason)
+  pick :: [ImportedModsVal] -> Maybe ImportedModsVal
+  pick = listToMaybe . sortBy (compare `on` prefer) . filter select
+    where select imv = case mod_name of Just name -> imv_name imv == name
+                                        Nothing   -> not (imv_qualified imv)
+          prefer imv = (imv_is_hiding imv, imv_span imv)
+
+  -- Which of these would export a 'foo'
+  -- (all of these are restricted imports, because if they were not, we
+  -- wouldn't have an out-of-scope error in the first place)
+  helpful_imports = filter helpful interesting_imports
+    where helpful (_,imv)
+            = not . null $ lookupGlobalRdrEnv (imv_all_exports imv) occ_name
+
+  -- Which of these do that because of an explicit hiding list resp. an
+  -- explicit import list
+  (helpful_imports_hiding, helpful_imports_non_hiding)
+    = partition (imv_is_hiding . snd) helpful_imports
+
 {-
 ************************************************************************
 *                                                                      *
@@ -1766,7 +2087,8 @@ warnUnusedTopBinds gres
          let isBoot = tcg_src env == HsBootFile
          let noParent gre = case gre_par gre of
                             NoParent -> True
-                            ParentIs _ -> False
+                            PatternSynonym -> True
+                            _        -> False
              -- Don't warn about unused bindings with parents in
              -- .hs-boot files, as you are sometimes required to give
              -- unused bindings (trac #3449).
@@ -1777,9 +2099,11 @@ warnUnusedTopBinds gres
                                else                 gres
          warnUnusedGREs gres'
 
-warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> FreeVars -> RnM ()
-warnUnusedLocalBinds = check_unused Opt_WarnUnusedLocalBinds
-warnUnusedMatches    = check_unused Opt_WarnUnusedMatches
+warnUnusedLocalBinds, warnUnusedMatches, warnUnusedTypePatterns
+  :: [Name] -> FreeVars -> RnM ()
+warnUnusedLocalBinds   = check_unused Opt_WarnUnusedLocalBinds
+warnUnusedMatches      = check_unused Opt_WarnUnusedMatches
+warnUnusedTypePatterns = check_unused Opt_WarnUnusedTypePatterns
 
 check_unused :: WarningFlag -> [Name] -> FreeVars -> RnM ()
 check_unused flag bound_names used_names
@@ -1791,24 +2115,42 @@ warnUnusedGREs :: [GlobalRdrElt] -> RnM ()
 warnUnusedGREs gres = mapM_ warnUnusedGRE gres
 
 warnUnusedLocals :: [Name] -> RnM ()
-warnUnusedLocals names = mapM_ warnUnusedLocal names
+warnUnusedLocals names = do
+    fld_env <- mkFieldEnv <$> getGlobalRdrEnv
+    mapM_ (warnUnusedLocal fld_env) names
 
-warnUnusedLocal :: Name -> RnM ()
-warnUnusedLocal name
+warnUnusedLocal :: NameEnv (FieldLabelString, Name) -> Name -> RnM ()
+warnUnusedLocal fld_env name
   = when (reportable name) $
-    addUnusedWarning name (nameSrcSpan name)
-                     (ptext (sLit "Defined but not used"))
+    addUnusedWarning Opt_WarnUnusedLocalBinds
+                     occ (nameSrcSpan name)
+                     (text "Defined but not used")
+  where
+    occ = case lookupNameEnv fld_env name of
+              Just (fl, _) -> mkVarOccFS fl
+              Nothing      -> nameOccName name
 
 warnUnusedGRE :: GlobalRdrElt -> RnM ()
-warnUnusedGRE (GRE { gre_name = name, gre_lcl = lcl, gre_imp = is })
-  | lcl       = warnUnusedLocal name
+warnUnusedGRE gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = is })
+  | lcl       = do fld_env <- mkFieldEnv <$> getGlobalRdrEnv
+                   warnUnusedLocal fld_env name
   | otherwise = when (reportable name) (mapM_ warn is)
   where
-    warn spec = addUnusedWarning name span msg
+    occ = greOccName gre
+    warn spec = addUnusedWarning Opt_WarnUnusedTopBinds occ span msg
         where
            span = importSpecLoc spec
            pp_mod = quotes (ppr (importSpecModule spec))
-           msg = ptext (sLit "Imported from") <+> pp_mod <+> ptext (sLit "but not used")
+           msg = text "Imported from" <+> pp_mod <+> ptext (sLit "but not used")
+
+-- | Make a map from selector names to field labels and parent tycon
+-- names, to be used when reporting unused record fields.
+mkFieldEnv :: GlobalRdrEnv -> NameEnv (FieldLabelString, Name)
+mkFieldEnv rdr_env = mkNameEnv [ (gre_name gre, (lbl, par_is (gre_par gre)))
+                               | gres <- occEnvElts rdr_env
+                               , gre <- gres
+                               , Just lbl <- [greLabel gre]
+                               ]
 
 reportable :: Name -> Bool
 reportable name
@@ -1817,79 +2159,83 @@ reportable name
                                   -- from Data.Tuple
   | otherwise = not (startsWithUnderscore (nameOccName name))
 
-addUnusedWarning :: Name -> SrcSpan -> SDoc -> RnM ()
-addUnusedWarning name span msg
-  = addWarnAt span $
+addUnusedWarning :: WarningFlag -> OccName -> SrcSpan -> SDoc -> RnM ()
+addUnusedWarning flag occ span msg
+  = addWarnAt (Reason flag) span $
     sep [msg <> colon,
-         nest 2 $ pprNonVarNameSpace (occNameSpace (nameOccName name))
-                        <+> quotes (ppr name)]
+         nest 2 $ pprNonVarNameSpace (occNameSpace occ)
+                        <+> quotes (ppr occ)]
 
 addNameClashErrRn :: RdrName -> [GlobalRdrElt] -> RnM ()
 addNameClashErrRn rdr_name gres
-  | all isLocalGRE gres  -- If there are two or more *local* defns, we'll have reported
-  = return ()            -- that already, and we don't want an error cascade
+  | all isLocalGRE gres && not (all isRecFldGRE gres)
+               -- If there are two or more *local* defns, we'll have reported
+  = return ()  -- that already, and we don't want an error cascade
   | otherwise
-  = addErr (vcat [ptext (sLit "Ambiguous occurrence") <+> quotes (ppr rdr_name),
-                  ptext (sLit "It could refer to") <+> vcat (msg1 : msgs)])
+  = addErr (vcat [text "Ambiguous occurrence" <+> quotes (ppr rdr_name),
+                  text "It could refer to" <+> vcat (msg1 : msgs)])
   where
     (np1:nps) = gres
     msg1 = ptext  (sLit "either") <+> mk_ref np1
-    msgs = [ptext (sLit "    or") <+> mk_ref np | np <- nps]
-    mk_ref gre = sep [quotes (ppr (gre_name gre)) <> comma, pprNameProvenance gre]
+    msgs = [text "    or" <+> mk_ref np | np <- nps]
+    mk_ref gre = sep [nom <> comma, pprNameProvenance gre]
+      where nom = case gre_par gre of
+                    FldParent { par_lbl = Just lbl } -> text "the field" <+> quotes (ppr lbl)
+                    _                                -> quotes (ppr (gre_name gre))
 
 shadowedNameWarn :: OccName -> [SDoc] -> SDoc
 shadowedNameWarn occ shadowed_locs
-  = sep [ptext (sLit "This binding for") <+> quotes (ppr occ)
-            <+> ptext (sLit "shadows the existing binding") <> plural shadowed_locs,
+  = sep [text "This binding for" <+> quotes (ppr occ)
+            <+> text "shadows the existing binding" <> plural shadowed_locs,
          nest 2 (vcat shadowed_locs)]
 
 perhapsForallMsg :: SDoc
 perhapsForallMsg
-  = vcat [ ptext (sLit "Perhaps you intended to use ExplicitForAll or similar flag")
-         , ptext (sLit "to enable explicit-forall syntax: forall <tvs>. <type>")]
+  = vcat [ text "Perhaps you intended to use ExplicitForAll or similar flag"
+         , text "to enable explicit-forall syntax: forall <tvs>. <type>"]
 
 unknownSubordinateErr :: SDoc -> RdrName -> SDoc
 unknownSubordinateErr doc op    -- Doc is "method of class" or
                                 -- "field of constructor"
-  = quotes (ppr op) <+> ptext (sLit "is not a (visible)") <+> doc
+  = quotes (ppr op) <+> text "is not a (visible)" <+> doc
 
 badOrigBinding :: RdrName -> SDoc
 badOrigBinding name
-  = ptext (sLit "Illegal binding of built-in syntax:") <+> ppr (rdrNameOcc name)
+  = text "Illegal binding of built-in syntax:" <+> ppr (rdrNameOcc name)
         -- The rdrNameOcc is because we don't want to print Prelude.(,)
 
 dupNamesErr :: Outputable n => (n -> SrcSpan) -> [n] -> RnM ()
 dupNamesErr get_loc names
   = addErrAt big_loc $
-    vcat [ptext (sLit "Conflicting definitions for") <+> quotes (ppr (head names)),
+    vcat [text "Conflicting definitions for" <+> quotes (ppr (head names)),
           locations]
   where
     locs      = map get_loc names
     big_loc   = foldr1 combineSrcSpans locs
-    locations = ptext (sLit "Bound at:") <+> vcat (map ppr (sort locs))
+    locations = text "Bound at:" <+> vcat (map ppr (sort locs))
 
 kindSigErr :: Outputable a => a -> SDoc
 kindSigErr thing
-  = hang (ptext (sLit "Illegal kind signature for") <+> quotes (ppr thing))
-       2 (ptext (sLit "Perhaps you intended to use KindSignatures"))
+  = hang (text "Illegal kind signature for" <+> quotes (ppr thing))
+       2 (text "Perhaps you intended to use KindSignatures")
 
 badQualBndrErr :: RdrName -> SDoc
 badQualBndrErr rdr_name
-  = ptext (sLit "Qualified name in binding position:") <+> ppr rdr_name
+  = text "Qualified name in binding position:" <+> ppr rdr_name
 
 opDeclErr :: RdrName -> SDoc
 opDeclErr n
-  = hang (ptext (sLit "Illegal declaration of a type or class operator") <+> quotes (ppr n))
-       2 (ptext (sLit "Use TypeOperators to declare operators in type and declarations"))
+  = hang (text "Illegal declaration of a type or class operator" <+> quotes (ppr n))
+       2 (text "Use TypeOperators to declare operators in type and declarations")
 
 checkTupSize :: Int -> RnM ()
 checkTupSize tup_size
   | tup_size <= mAX_TUPLE_SIZE
   = return ()
   | otherwise
-  = addErr (sep [ptext (sLit "A") <+> int tup_size <> ptext (sLit "-tuple is too large for GHC"),
-                 nest 2 (parens (ptext (sLit "max size is") <+> int mAX_TUPLE_SIZE)),
-                 nest 2 (ptext (sLit "Workaround: use nested tuples or define a data type"))])
+  = addErr (sep [text "A" <+> int tup_size <> ptext (sLit "-tuple is too large for GHC"),
+                 nest 2 (parens (text "max size is" <+> int mAX_TUPLE_SIZE)),
+                 nest 2 (text "Workaround: use nested tuples or define a data type")])
 
 {-
 ************************************************************************
@@ -1899,6 +2245,8 @@ checkTupSize tup_size
 ************************************************************************
 -}
 
+-- AZ:TODO: Change these all to be Name instead of RdrName.
+--          Merge TcType.UserTypeContext in to it.
 data HsDocContext
   = TypeSigCtx SDoc
   | PatCtx
@@ -1910,7 +2258,8 @@ data HsDocContext
   | TyDataCtx (Located RdrName)
   | TySynCtx (Located RdrName)
   | TyFamilyCtx (Located RdrName)
-  | ConDeclCtx [Located RdrName]
+  | FamPatCtx (Located RdrName)    -- The patterns of a type/data family instance
+  | ConDeclCtx [Located Name]
   | ClassDeclCtx (Located RdrName)
   | ExprWithTySigCtx
   | TypBrCtx
@@ -1921,29 +2270,37 @@ data HsDocContext
   | VectDeclCtx (Located RdrName)
   | GenericCtx SDoc   -- Maybe we want to use this more!
 
-docOfHsDocContext :: HsDocContext -> SDoc
-docOfHsDocContext (GenericCtx doc) = doc
-docOfHsDocContext (TypeSigCtx doc) = text "In the type signature for" <+> doc
-docOfHsDocContext PatCtx = text "In a pattern type-signature"
-docOfHsDocContext SpecInstSigCtx = text "In a SPECIALISE instance pragma"
-docOfHsDocContext DefaultDeclCtx = text "In a `default' declaration"
-docOfHsDocContext (ForeignDeclCtx name) = ptext (sLit "In the foreign declaration for") <+> ppr name
-docOfHsDocContext DerivDeclCtx = text "In a deriving declaration"
-docOfHsDocContext (RuleCtx name) = text "In the transformation rule" <+> ftext name
-docOfHsDocContext (TyDataCtx tycon) = text "In the data type declaration for" <+> quotes (ppr tycon)
-docOfHsDocContext (TySynCtx name) = text "In the declaration for type synonym" <+> quotes (ppr name)
-docOfHsDocContext (TyFamilyCtx name) = text "In the declaration for type family" <+> quotes (ppr name)
-
-docOfHsDocContext (ConDeclCtx [name])
-   = text "In the definition of data constructor" <+> quotes (ppr name)
-docOfHsDocContext (ConDeclCtx names)
-   = text "In the definition of data constructors" <+> interpp'SP names
-
-docOfHsDocContext (ClassDeclCtx name) = text "In the declaration for class"     <+> ppr name
-docOfHsDocContext ExprWithTySigCtx = text "In an expression type signature"
-docOfHsDocContext TypBrCtx = ptext (sLit "In a Template-Haskell quoted type")
-docOfHsDocContext HsTypeCtx = text "In a type argument"
-docOfHsDocContext GHCiCtx = ptext (sLit "In GHCi input")
-docOfHsDocContext (SpliceTypeCtx hs_ty) = ptext (sLit "In the spliced type") <+> ppr hs_ty
-docOfHsDocContext ClassInstanceCtx = ptext (sLit "TcSplice.reifyInstances")
-docOfHsDocContext (VectDeclCtx tycon) = ptext (sLit "In the VECTORISE pragma for type constructor") <+> quotes (ppr tycon)
+withHsDocContext :: HsDocContext -> SDoc -> SDoc
+withHsDocContext ctxt doc = doc $$ inHsDocContext ctxt
+
+inHsDocContext :: HsDocContext -> SDoc
+inHsDocContext ctxt = text "In" <+> pprHsDocContext ctxt
+
+pprHsDocContext :: HsDocContext -> SDoc
+pprHsDocContext (GenericCtx doc)      = doc
+pprHsDocContext (TypeSigCtx doc)      = text "the type signature for" <+> doc
+pprHsDocContext PatCtx                = text "a pattern type-signature"
+pprHsDocContext SpecInstSigCtx        = text "a SPECIALISE instance pragma"
+pprHsDocContext DefaultDeclCtx        = text "a `default' declaration"
+pprHsDocContext DerivDeclCtx          = text "a deriving declaration"
+pprHsDocContext (RuleCtx name)        = text "the transformation rule" <+> ftext name
+pprHsDocContext (TyDataCtx tycon)     = text "the data type declaration for" <+> quotes (ppr tycon)
+pprHsDocContext (FamPatCtx tycon)     = text "a type pattern of family instance for" <+> quotes (ppr tycon)
+pprHsDocContext (TySynCtx name)       = text "the declaration for type synonym" <+> quotes (ppr name)
+pprHsDocContext (TyFamilyCtx name)    = text "the declaration for type family" <+> quotes (ppr name)
+pprHsDocContext (ClassDeclCtx name)   = text "the declaration for class" <+> quotes (ppr name)
+pprHsDocContext ExprWithTySigCtx      = text "an expression type signature"
+pprHsDocContext TypBrCtx              = text "a Template-Haskell quoted type"
+pprHsDocContext HsTypeCtx             = text "a type argument"
+pprHsDocContext GHCiCtx               = text "GHCi input"
+pprHsDocContext (SpliceTypeCtx hs_ty) = text "the spliced type" <+> quotes (ppr hs_ty)
+pprHsDocContext ClassInstanceCtx      = text "TcSplice.reifyInstances"
+
+pprHsDocContext (ForeignDeclCtx name)
+   = text "the foreign declaration for" <+> quotes (ppr name)
+pprHsDocContext (ConDeclCtx [name])
+   = text "the definition of data constructor" <+> quotes (ppr name)
+pprHsDocContext (ConDeclCtx names)
+   = text "the definition of data constructors" <+> interpp'SP names
+pprHsDocContext (VectDeclCtx tycon)
+   = text "the VECTORISE pragma for type constructor" <+> quotes (ppr tycon)