Print which warning-flag controls an emitted warning
[ghc.git] / compiler / rename / RnEnv.hs
index 13d5b7f..0ecd85e 100644 (file)
@@ -4,7 +4,7 @@
 \section[RnEnv]{Environment manipulation for the renamer monad}
 -}
 
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, MultiWayIf #-}
 
 module RnEnv (
         newTopSrcBinder,
@@ -13,7 +13,7 @@ module RnEnv (
         lookupLocalOccRn_maybe, lookupInfoOccRn,
         lookupLocalOccThLvl_maybe,
         lookupTypeOccRn, lookupKindOccRn,
-        lookupGlobalOccRn, lookupGlobalOccRn_maybe,
+        lookupGlobalOccRn, lookupGlobalOccRnExport, lookupGlobalOccRn_maybe,
         lookupOccRn_overloaded, lookupGlobalOccRn_overloaded,
         reportUnboundName, unknownNameSuggestions,
         addNameClashErrRn,
@@ -21,12 +21,13 @@ module RnEnv (
         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,
+        getLookupOccRn,mkUnboundName, mkUnboundNameRdr, isUnboundName,
         addUsedGRE, addUsedGREs, addUsedDataCons,
 
         newLocalBndrRn, newLocalBndrsRn,
@@ -37,13 +38,15 @@ module RnEnv (
         extendTyVarEnvFVRn,
 
         checkDupRdrNames, checkShadowedRdrNames,
-        checkDupNames, checkDupAndShadowedNames, checkTupSize,
+        checkDupNames, checkDupAndShadowedNames, dupNamesErr,
+        checkTupSize,
         addFvRn, mapFvRn, mapMaybeFvRn, mapFvRnCPS,
-        warnUnusedMatches,
+        warnUnusedMatches, warnUnusedTypePatterns,
         warnUnusedTopBinds, warnUnusedLocalBinds,
         mkFieldEnv,
         dataTcOccs, kindSigErr, perhapsForallMsg, unknownSubordinateErr,
-        HsDocContext(..), docOfHsDocContext
+        HsDocContext(..), pprHsDocContext,
+        inHsDocContext, withHsDocContext
     ) where
 
 #include "HsVersions.h"
@@ -56,6 +59,7 @@ import HscTypes
 import TcEnv
 import TcRnMonad
 import RdrHsSyn         ( setRdrNameSpace )
+import TysWiredIn       ( starKindTyConName, unicodeStarKindTyConName )
 import Name
 import NameSet
 import NameEnv
@@ -80,6 +84,7 @@ import Data.List
 import Data.Function    ( on )
 import ListSetOps       ( minusList )
 import Constants        ( mAX_TUPLE_SIZE )
+import qualified GHC.LanguageExtensions as LangExt
 
 {-
 *********************************************************
@@ -224,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 ->
@@ -299,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
@@ -368,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" ]
 
 
 -----------------------------------------------
@@ -412,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
-                          (Just 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)
 
 
 -----------------------------------------------
@@ -426,7 +435,7 @@ 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
 
@@ -445,9 +454,11 @@ lookupConstructorFields con_name
   = do  { this_mod <- getModule
         ; if nameIsLocalOrFrom this_mod con_name then
           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) } }
 
 -----------------------------------------------
@@ -462,58 +473,77 @@ lookupConstructorFields con_name
 -- Arguably this should work, because the reference to 'fld' is
 -- 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
-                 -> Maybe Name  -- Nothing => just look it up as usual
-                                -- Just p  => use parent 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) }
 
-  | 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
+  | 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
+  = 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 { addUsedGRE warnIfDeprec gre
-                          -- Add a usage; this is an *occurrence* site
-                          -- Note [Usage for sub-bndrs]
-                        ; return (gre_name gre) }
-            []    -> do { ns <- lookupQualifiedNameGHCi rdr_name
-                        ; case ns of {
-                                (n:_) -> return n ;
-                                -- Unlikely to be more than one...?
-                                [] -> do
-                        { addErr (unknownSubordinateErr doc rdr_name)
-                        ; return (mkUnboundName rdr_name) } } }
-            gres  -> do { addNameClashErrRn rdr_name gres
-                        ; return (gre_name (head gres)) } }
-
-lookupSubBndrGREs :: GlobalRdrEnv -> Maybe Name -> RdrName -> [GlobalRdrElt]
--- If parent = Nothing, just do a normal lookup
--- If parent = Just 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
-      Nothing               -> pickGREs rdr_name gres
-      Just p
-        | isUnqual rdr_name -> filter (parent_is p) gres
-        | otherwise         -> filter (parent_is p) (pickGREs rdr_name 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
-    gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name)
-
-    parent_is p (GRE { gre_par = ParentIs p' })             = p == p'
-    parent_is p (GRE { gre_par = FldParent { par_is = 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]
@@ -655,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
 
@@ -681,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
@@ -693,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 }
 
@@ -714,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
       $$
@@ -723,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]
 ~~~~~~~~~~~~~~~
@@ -764,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
@@ -785,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
@@ -804,24 +894,6 @@ 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
-
-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
-                Nothing  -> return Nothing
-                Just gre -> return (Just (gre_name gre)) }
-
-
 -- | Like 'lookupOccRn_maybe', but with a more informative result if
 -- the 'RdrName' happens to be a record selector:
 --
@@ -863,7 +935,10 @@ lookupGlobalOccRn_overloaded overload_ok rdr_name
                 []    -> return Nothing
                 [gre] | isRecFldGRE gre
                          -> do { addUsedGRE True gre
-                               ; let fld_occ = FieldOcc rdr_name (gre_name 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
@@ -871,7 +946,10 @@ lookupGlobalOccRn_overloaded overload_ok rdr_name
                 gres  | all isRecFldGRE gres && overload_ok
                             -- Don't record usage for ambiguous selectors
                             -- until we know which is meant
-                         -> return (Just (Right (map (FieldOcc rdr_name . gre_name) gres)))
+                         -> return
+                             (Just (Right
+                                     (map (FieldOcc (noLoc rdr_name) . gre_name)
+                                           gres)))
                 gres     -> do { addNameClashErrRn rdr_name gres
                                ; return (Just (Left (gre_name (head gres)))) } }
 
@@ -887,6 +965,7 @@ 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
@@ -902,6 +981,7 @@ 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
@@ -916,13 +996,14 @@ 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
+        ; let name = mkUnboundNameRdr rdr_name
         ; return (name, avail name) } } }
 
 {-
@@ -988,33 +1069,34 @@ 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 occ) <+> 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")
+      = 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
-       FldParent { par_is = p } -> mi_warn_fn iface p
+       ParentIs  p              -> mi_warn_fn iface (nameOccName p)
+       FldParent { par_is = p } -> mi_warn_fn iface (nameOccName p)
        NoParent                 -> Nothing
        PatternSynonym           -> Nothing
 
@@ -1089,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]
@@ -1163,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
@@ -1195,16 +1278,9 @@ lookupBindGroupOcc ctxt what rdr_name
       InstDeclCtxt ns  -> lookup_top (`elemNameSet` ns)
   where
     lookup_cls_op cls
-      = do { env <- getGlobalRdrEnv
-           ; let gres = lookupSubBndrGREs env (Just 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
@@ -1223,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.
@@ -1244,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
@@ -1347,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)
@@ -1357,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
@@ -1385,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)
+
+
 {-
 ************************************************************************
 *                                                                      *
@@ -1441,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 { rebindable_on <- xoptM Opt_RebindableSyntax
+  = 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) } }
 
 {-
 *********************************************************
@@ -1587,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
@@ -1598,14 +1740,17 @@ 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 | isRecFldGRE gre
         = do { dflags <- getDynFlags
-             ; return $ not (xopt Opt_RecordPuns dflags || xopt Opt_RecordWildCards dflags) }
+             ; return $ not (xopt LangExt.RecordPuns dflags
+                             || xopt LangExt.RecordWildCards dflags) }
     is_shadowed_gre _other = return True
 
 {-
@@ -1640,11 +1785,11 @@ unboundNameX where_look rdr_name extra
                   ; let suggestions = unknownNameSuggestions_ where_look
                                         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
@@ -1678,7 +1823,7 @@ similarNameSuggestions where_look dflags global_env
   = 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))]
@@ -1688,15 +1833,15 @@ similarNameSuggestions 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
@@ -1794,42 +1939,42 @@ importSuggestions _dflags imports rdr_name
   | null interesting_imports
   , Just name <- mod_name
   = hsep
-      [ ptext (sLit "No module named")
+      [ text "No module named"
       , quotes (ppr name)
-      , ptext (sLit "is imported.")
+      , text "is imported."
       ]
   | is_qualified
   , null helpful_imports
   , [(mod,_)] <- interesting_imports
   = hsep
-      [ ptext (sLit "Module")
+      [ text "Module"
       , quotes (ppr mod)
-      , ptext (sLit "does not export")
+      , text "does not export"
       , quotes (ppr occ_name) <> dot
       ]
   | is_qualified
   , null helpful_imports
   , mods <- map fst interesting_imports
   = hsep
-      [ ptext (sLit "Neither")
+      [ text "Neither"
       , quotedListWithNor (map ppr mods)
-      , ptext (sLit "exports")
+      , text "exports"
       , quotes (ppr occ_name) <> dot
       ]
   | [(mod,imv)] <- helpful_imports_non_hiding
   = fsep
-      [ ptext (sLit "Perhaps you want to add")
+      [ text "Perhaps you want to add"
       , quotes (ppr occ_name)
-      , ptext (sLit "to the import list")
-      , ptext (sLit "in the import of")
+      , 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
-      [ ptext (sLit "Perhaps you want to add")
+      [ text "Perhaps you want to add"
       , quotes (ppr occ_name)
-      , ptext (sLit "to one of these import lists:")
+      , text "to one of these import lists:"
       ]
     $$
     nest 2 (vcat
@@ -1838,19 +1983,19 @@ importSuggestions _dflags imports rdr_name
         ])
   | [(mod,imv)] <- helpful_imports_hiding
   = fsep
-      [ ptext (sLit "Perhaps you want to remove")
+      [ text "Perhaps you want to remove"
       , quotes (ppr occ_name)
-      , ptext (sLit "from the explicit hiding list")
-      , ptext (sLit "in the import of")
+      , 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
-      [ ptext (sLit "Perhaps you want to remove")
+      [ text "Perhaps you want to remove"
       , quotes (ppr occ_name)
-      , ptext (sLit "from the hiding clauses")
-      , ptext (sLit "in one of these imports:")
+      , text "from the hiding clauses"
+      , text "in one of these imports:"
       ]
     $$
     nest 2 (vcat
@@ -1954,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
@@ -1975,8 +2122,9 @@ warnUnusedLocals names = do
 warnUnusedLocal :: NameEnv (FieldLabelString, Name) -> Name -> RnM ()
 warnUnusedLocal fld_env name
   = when (reportable name) $
-    addUnusedWarning occ (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
@@ -1989,11 +2137,11 @@ warnUnusedGRE gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = is })
   | otherwise = when (reportable name) (mapM_ warn is)
   where
     occ = greOccName gre
-    warn spec = addUnusedWarning occ span msg
+    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.
@@ -2011,9 +2159,9 @@ reportable name
                                   -- from Data.Tuple
   | otherwise = not (startsWithUnderscore (nameOccName name))
 
-addUnusedWarning :: OccName -> SrcSpan -> SDoc -> RnM ()
-addUnusedWarning occ 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 occ)
                         <+> quotes (ppr occ)]
@@ -2024,12 +2172,12 @@ addNameClashErrRn rdr_name 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]
+    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)
@@ -2037,57 +2185,57 @@ addNameClashErrRn rdr_name gres
 
 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")])
 
 {-
 ************************************************************************
@@ -2097,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
@@ -2108,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
@@ -2119,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)