Refactor visible type application.
[ghc.git] / compiler / rename / RnSource.hs
index 2c9331f..df729dc 100644 (file)
@@ -7,16 +7,16 @@
 {-# LANGUAGE CPP, ScopedTypeVariables #-}
 
 module RnSource (
-        rnSrcDecls, addTcgDUs, rnTyClDecls, findSplice
+        rnSrcDecls, addTcgDUs, findSplice
     ) where
 
 #include "HsVersions.h"
 
 import {-# SOURCE #-} RnExpr( rnLExpr )
-import {-# SOURCE #-} RnSplice ( rnSpliceDecl )
-import {-# SOURCE #-} TcSplice ( runQuasiQuoteDecl )
+import {-# SOURCE #-} RnSplice ( rnSpliceDecl, rnTopSpliceDecls )
 
 import HsSyn
+import FieldLabel
 import RdrName
 import RnTypes
 import RnBinds
@@ -30,28 +30,31 @@ import ForeignCall      ( CCallTarget(..) )
 import Module
 import HscTypes         ( Warnings(..), plusWarns )
 import Class            ( FunDep )
-import PrelNames        ( isUnboundName )
+import PrelNames        ( applicativeClassName, pureAName, thenAName
+                        , monadClassName, returnMName, thenMName
+                        , monadFailClassName, failMName, failMName_preMFP
+                        , semigroupClassName, sappendName
+                        , monoidClassName, mappendName
+                        )
 import Name
 import NameSet
 import NameEnv
 import Avail
 import Outputable
 import Bag
-import BasicTypes       ( RuleName )
+import BasicTypes       ( RuleName, pprRuleName )
 import FastString
 import SrcLoc
 import DynFlags
 import HscTypes         ( HscEnv, hsc_dflags )
-import ListSetOps       ( findDupsEq, removeDups )
+import ListSetOps       ( findDupsEq, removeDups, equivClasses )
 import Digraph          ( SCC, flattenSCC, stronglyConnCompFromEdgedVertices )
-import Util             ( mapSnd )
+import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
-import Data.List( partition, sortBy )
-#if __GLASGOW_HASKELL__ < 709
-import Data.Traversable (traverse)
-#endif
+import Data.List ( sortBy )
 import Maybes( orElse, mapMaybe )
+import qualified Data.Set as Set ( difference, fromList, toList, null )
 
 {-
 @rnSourceDecl@ `renames' declarations.
@@ -72,21 +75,21 @@ Checks the @(..)@ etc constraints in the export list.
 
 -- Brings the binders of the group into scope in the appropriate places;
 -- does NOT assume that anything is in scope already
-rnSrcDecls :: [Name] -> HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
+rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
 -- Rename a top-level HsGroup; used for normal source files *and* hs-boot files
-rnSrcDecls extra_deps group@(HsGroup { hs_valds   = val_decls,
-                                       hs_splcds  = splice_decls,
-                                       hs_tyclds  = tycl_decls,
-                                       hs_instds  = inst_decls,
-                                       hs_derivds = deriv_decls,
-                                       hs_fixds   = fix_decls,
-                                       hs_warnds  = warn_decls,
-                                       hs_annds   = ann_decls,
-                                       hs_fords   = foreign_decls,
-                                       hs_defds   = default_decls,
-                                       hs_ruleds  = rule_decls,
-                                       hs_vects   = vect_decls,
-                                       hs_docs    = docs })
+rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
+                            hs_splcds  = splice_decls,
+                            hs_tyclds  = tycl_decls,
+                            hs_instds  = inst_decls,
+                            hs_derivds = deriv_decls,
+                            hs_fixds   = fix_decls,
+                            hs_warnds  = warn_decls,
+                            hs_annds   = ann_decls,
+                            hs_fords   = foreign_decls,
+                            hs_defds   = default_decls,
+                            hs_ruleds  = rule_decls,
+                            hs_vects   = vect_decls,
+                            hs_docs    = docs })
  = do {
    -- (A) Process the fixity declarations, creating a mapping from
    --     FastStrings to FixItems.
@@ -94,33 +97,42 @@ rnSrcDecls extra_deps group@(HsGroup { hs_valds   = val_decls,
    local_fix_env <- makeMiniFixityEnv fix_decls ;
 
    -- (B) Bring top level binders (and their fixities) into scope,
-   --     *except* for the value bindings, which get brought in below.
-   --     However *do* include class ops, data constructors
-   --     And for hs-boot files *do* include the value signatures
+   --     *except* for the value bindings, which get done in step (D)
+   --     with collectHsIdBinders. However *do* include
+   --
+   --        * Class ops, data constructors, and record fields,
+   --          because they do not have value declarations.
+   --          Aso step (C) depends on datacons and record fields
+   --
+   --        * For hs-boot files, include the value signatures
+   --          Again, they have no value declarations
+   --
    (tc_envs, tc_bndrs) <- getLocalNonValBinders local_fix_env group ;
+
+
    setEnvs tc_envs $ do {
 
    failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
 
-   -- (C) Extract the mapping from data constructors to field names and
-   --     extend the record field env.
-   --     This depends on the data constructors and field names being in
-   --     scope from (B) above
-   inNewEnv (extendRecordFieldEnv tycl_decls inst_decls) $ \ _ -> do {
+   -- (D1) Bring pattern synonyms into scope.
+   --      Need to do this before (D2) because rnTopBindsLHS
+   --      looks up those pattern synonyms (Trac #9889)
 
-   -- (D) Rename the left-hand sides of the value bindings.
+   extendPatSynEnv val_decls local_fix_env $ \pat_syn_bndrs -> do {
+
+   -- (D2) Rename the left-hand sides of the value bindings.
    --     This depends on everything from (B) being in scope,
    --     and on (C) for resolving record wild cards.
    --     It uses the fixity env from (A) to bind fixities for view patterns.
    new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
-   -- bind the LHSes (and their fixities) in the global rdr environment
-   let { val_binders = collectHsValBinders new_lhs ;
-         all_bndrs   = extendNameSetList tc_bndrs val_binders ;
-         val_avails  = map Avail val_binders  } ;
-   traceRn (text "rnSrcDecls" <+> ppr val_avails) ;
-   (tcg_env, tcl_env) <- extendGlobalRdrEnvRn val_avails local_fix_env ;
-   traceRn (ptext (sLit "Val binders") <+> (ppr val_binders)) ;
-   setEnvs (tcg_env, tcl_env) $ do {
+
+   -- Bind the LHSes (and their fixities) in the global rdr environment
+   let { id_bndrs = collectHsIdBinders new_lhs } ;  -- Excludes pattern-synonym binders
+                                                    -- They are already in scope
+   traceRn (text "rnSrcDecls" <+> ppr id_bndrs) ;
+   tc_envs <- extendGlobalRdrEnvRn (map avail id_bndrs) local_fix_env ;
+   traceRn (text "D2" <+> ppr (tcg_rdr_env (fst tc_envs)));
+   setEnvs tc_envs $ do {
 
    --  Now everything is in scope, as the remaining renaming assumes.
 
@@ -135,17 +147,25 @@ rnSrcDecls extra_deps group@(HsGroup { hs_valds   = val_decls,
    -- means we'll only report a declaration as unused if it isn't
    -- mentioned at all.  Ah well.
    traceRn (text "Start rnTyClDecls") ;
-   (rn_tycl_decls, src_fvs1) <- rnTyClDecls extra_deps tycl_decls ;
+   (rn_tycl_decls, src_fvs1) <- rnTyClDecls tycl_decls ;
 
    -- (F) Rename Value declarations right-hand sides
    traceRn (text "Start rnmono") ;
-   (rn_val_decls, bind_dus) <- rnTopBindsRHS all_bndrs new_lhs ;
+   let { val_bndr_set = mkNameSet id_bndrs `unionNameSet` mkNameSet pat_syn_bndrs } ;
+   is_boot <- tcIsHsBootOrSig ;
+   (rn_val_decls, bind_dus) <- if is_boot
+    -- For an hs-boot, use tc_bndrs (which collects how we're renamed
+    -- signatures), since val_bndr_set is empty (there are no x = ...
+    -- bindings in an hs-boot.)
+    then rnTopBindsBoot tc_bndrs new_lhs
+    else rnValBindsRHS (TopSigCtxt val_bndr_set) new_lhs ;
    traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
 
    -- (G) Rename Fixity and deprecations
 
    -- Rename fixity declarations and error if we try to
    -- fix something from another module (duplicates were checked in (A))
+   let { all_bndrs = tc_bndrs `unionNameSet` val_bndr_set } ;
    rn_fix_decls <- rnSrcFixityDecls all_bndrs fix_decls ;
 
    -- Rename deprec decls;
@@ -156,8 +176,8 @@ rnSrcDecls extra_deps group@(HsGroup { hs_valds   = val_decls,
    -- (H) Rename Everything else
 
    (rn_inst_decls,    src_fvs2) <- rnList rnSrcInstDecl   inst_decls ;
-   (rn_rule_decls,    src_fvs3) <- setXOptM Opt_ScopedTypeVariables $
-                                   rnList rnHsRuleDecl    rule_decls ;
+   (rn_rule_decls,    src_fvs3) <- setXOptM LangExt.ScopedTypeVariables $
+                                   rnList rnHsRuleDecls rule_decls ;
                            -- Inside RULES, scoped type variables are on
    (rn_vect_decls,    src_fvs4) <- rnList rnHsVectDecl    vect_decls ;
    (rn_foreign_decls, src_fvs5) <- rnList rnHsForeignDecl foreign_decls ;
@@ -168,7 +188,7 @@ rnSrcDecls extra_deps group@(HsGroup { hs_valds   = val_decls,
       -- Haddock docs; no free vars
    rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
 
-    last_tcg_env <- getGblEnv ;
+   last_tcg_env <- getGblEnv ;
    -- (I) Compute the results and return
    let {rn_group = HsGroup { hs_valds   = rn_val_decls,
                              hs_splcds  = rn_splice_decls,
@@ -185,9 +205,8 @@ rnSrcDecls extra_deps group@(HsGroup { hs_valds   = val_decls,
                              hs_vects  = rn_vect_decls,
                              hs_docs   = rn_docs } ;
 
-        tycl_bndrs = hsTyClDeclsBinders rn_tycl_decls rn_inst_decls ;
-        ford_bndrs = hsForeignDeclsBinders rn_foreign_decls ;
-        other_def  = (Just (mkNameSet tycl_bndrs `unionNameSet` mkNameSet ford_bndrs), emptyNameSet) ;
+        tcf_bndrs = hsTyClForeignBinders rn_tycl_decls rn_inst_decls rn_foreign_decls ;
+        other_def  = (Just (mkNameSet tcf_bndrs), emptyNameSet) ;
         other_fvs  = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4,
                               src_fvs5, src_fvs6, src_fvs7, src_fvs8,
                               src_fvs9] ;
@@ -201,18 +220,12 @@ rnSrcDecls extra_deps group@(HsGroup { hs_valds   = val_decls,
                         in -- we return the deprecs in the env, not in the HsGroup above
                         tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
        } ;
-
+   traceRn (text "last" <+> ppr (tcg_rdr_env final_tcg_env)) ;
    traceRn (text "finish rnSrc" <+> ppr rn_group) ;
    traceRn (text "finish Dus" <+> ppr src_dus ) ;
    return (final_tcg_env, rn_group)
                     }}}}
 
--- some utils because we do this a bunch above
--- compute and install the new env
-inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
-inNewEnv env cont = do e <- env
-                       setGblEnv e $ cont e
-
 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
 -- This function could be defined lower down in the module hierarchy,
 -- but there doesn't seem anywhere very logical to put it.
@@ -262,8 +275,7 @@ rnSrcFixityDecls bndr_set fix_decls
   = do fix_decls <- mapM rn_decl fix_decls
        return (concat fix_decls)
   where
-    sig_ctxt = TopSigCtxt bndr_set True
-       -- True <=> can give fixity for class decls and record selectors
+    sig_ctxt = TopSigCtxt bndr_set
 
     rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
         -- GHC extension: look up both the tycon and data con
@@ -280,8 +292,8 @@ rnSrcFixityDecls bndr_set fix_decls
       = setSrcSpan name_loc $
                     -- this lookup will fail if the definition isn't local
         do names <- lookupLocalTcNames sig_ctxt what rdr_name
-           return [ L name_loc name | name <- names ]
-    what = ptext (sLit "fixity signature")
+           return [ L name_loc name | (_, name) <- names ]
+    what = text "fixity signature"
 
 {-
 *********************************************************
@@ -298,11 +310,11 @@ gather them together.
 -}
 
 -- checks that the deprecations are defined locally, and that there are no duplicates
-rnSrcWarnDecls :: NameSet -> [LWarnDecl RdrName] -> RnM Warnings
+rnSrcWarnDecls :: NameSet -> [LWarnDecls RdrName] -> RnM Warnings
 rnSrcWarnDecls _ []
   = return NoWarnings
 
-rnSrcWarnDecls bndr_set decls
+rnSrcWarnDecls bndr_set decls'
   = do { -- check for duplicates
        ; mapM_ (\ dups -> let (L loc rdr:lrdr':_) = dups
                           in addErrAt loc (dupWarnDecl lrdr' rdr))
@@ -310,17 +322,20 @@ rnSrcWarnDecls bndr_set decls
        ; pairs_s <- mapM (addLocM rn_deprec) decls
        ; return (WarnSome ((concat pairs_s))) }
  where
-   sig_ctxt = TopSigCtxt bndr_set True
-      -- True <=> Can give deprecations for class ops and record sels
+   decls = concatMap (\(L _ d) -> wd_warnings d) decls'
 
-   rn_deprec (Warning rdr_name txt)
+   sig_ctxt = TopSigCtxt bndr_set
+
+   rn_deprec (Warning rdr_names txt)
        -- ensures that the names are defined locally
-     = do { names <- lookupLocalTcNames sig_ctxt what rdr_name
-          ; return [(nameOccName name, txt) | name <- names] }
+     = do { names <- concatMapM (lookupLocalTcNames sig_ctxt what . unLoc)
+                                rdr_names
+          ; return [(rdrNameOcc rdr, txt) | (rdr, _) <- names] }
 
-   what = ptext (sLit "deprecation")
+   what = text "deprecation"
 
-   warn_rdr_dups = findDupRdrNames (map (\ (L loc (Warning rdr_name _)) -> L loc rdr_name) decls)
+   warn_rdr_dups = findDupRdrNames $ concatMap (\(L _ (Warning ns _)) -> ns)
+                                               decls
 
 findDupRdrNames :: [Located RdrName] -> [[Located RdrName]]
 findDupRdrNames = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
@@ -332,8 +347,8 @@ findDupRdrNames = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (
 dupWarnDecl :: Located RdrName -> RdrName -> SDoc
 -- Located RdrName -> DeprecDecl RdrName -> SDoc
 dupWarnDecl (L loc _) rdr_name
-  = vcat [ptext (sLit "Multiple warning declarations for") <+> quotes (ppr rdr_name),
-          ptext (sLit "also at ") <+> ppr loc]
+  = vcat [text "Multiple warning declarations for" <+> quotes (ppr rdr_name),
+          text "also at " <+> ppr loc]
 
 {-
 *********************************************************
@@ -344,12 +359,13 @@ dupWarnDecl (L loc _) rdr_name
 -}
 
 rnAnnDecl :: AnnDecl RdrName -> RnM (AnnDecl Name, FreeVars)
-rnAnnDecl ann@(HsAnnotation provenance expr)
+rnAnnDecl ann@(HsAnnotation provenance expr)
   = addErrCtxt (annCtxt ann) $
     do { (provenance', provenance_fvs) <- rnAnnProvenance provenance
-       ; (expr', expr_fvs) <- setStage (Splice False) $
+       ; (expr', expr_fvs) <- setStage (Splice Untyped) $
                               rnLExpr expr
-       ; return (HsAnnotation provenance' expr', provenance_fvs `plusFV` expr_fvs) }
+       ; return (HsAnnotation s provenance' expr',
+                 provenance_fvs `plusFV` expr_fvs) }
 
 rnAnnProvenance :: AnnProvenance RdrName -> RnM (AnnProvenance Name, FreeVars)
 rnAnnProvenance provenance = do
@@ -380,21 +396,26 @@ rnDefaultDecl (DefaultDecl tys)
 -}
 
 rnHsForeignDecl :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
-rnHsForeignDecl (ForeignImport name ty _ spec)
+rnHsForeignDecl (ForeignImport { fd_name = name, fd_sig_ty = ty, fd_fi = spec })
   = do { topEnv :: HscEnv <- getTopEnv
        ; name' <- lookupLocatedTopBndrRn name
-       ; (ty', fvs) <- rnLHsType (ForeignDeclCtx name) ty
+       ; (ty', fvs) <- rnHsSigType (ForeignDeclCtx name) ty
 
         -- Mark any PackageTarget style imports as coming from the current package
-       ; let packageKey = thisPackage $ hsc_dflags topEnv
-             spec'      = patchForeignImport packageKey spec
+       ; let unitId = thisPackage $ hsc_dflags topEnv
+             spec'      = patchForeignImport unitId spec
 
-       ; return (ForeignImport name' ty' noForeignImportCoercionYet spec', fvs) }
+       ; return (ForeignImport { fd_name = name', fd_sig_ty = ty'
+                               , fd_co = noForeignImportCoercionYet
+                               , fd_fi = spec' }, fvs) }
 
-rnHsForeignDecl (ForeignExport name ty _ spec)
+rnHsForeignDecl (ForeignExport { fd_name = name, fd_sig_ty = ty, fd_fe = spec })
   = do { name' <- lookupLocatedOccRn name
-       ; (ty', fvs) <- rnLHsType (ForeignDeclCtx name) ty
-       ; return (ForeignExport name' ty' noForeignExportCoercionYet spec, fvs `addOneFV` unLoc name') }
+       ; (ty', fvs) <- rnHsSigType (ForeignDeclCtx name) ty
+       ; return (ForeignExport { fd_name = name', fd_sig_ty = ty'
+                               , fd_co = noForeignExportCoercionYet
+                               , fd_fe = spec }
+                , fvs `addOneFV` unLoc name') }
         -- NB: a foreign export is an *occurrence site* for name, so
         --     we add it to the free-variable list.  It might, for example,
         --     be imported from another module
@@ -404,21 +425,22 @@ rnHsForeignDecl (ForeignExport name ty _ spec)
 --      package, so if they get inlined across a package boundry we'll still
 --      know where they're from.
 --
-patchForeignImport :: PackageKey -> ForeignImport -> ForeignImport
-patchForeignImport packageKey (CImport cconv safety fs spec src)
-        = CImport cconv safety fs (patchCImportSpec packageKey spec) src
+patchForeignImport :: UnitId -> ForeignImport -> ForeignImport
+patchForeignImport unitId (CImport cconv safety fs spec src)
+        = CImport cconv safety fs (patchCImportSpec unitId spec) src
 
-patchCImportSpec :: PackageKey -> CImportSpec -> CImportSpec
-patchCImportSpec packageKey spec
+patchCImportSpec :: UnitId -> CImportSpec -> CImportSpec
+patchCImportSpec unitId spec
  = case spec of
-        CFunction callTarget    -> CFunction $ patchCCallTarget packageKey callTarget
+        CFunction callTarget    -> CFunction $ patchCCallTarget unitId callTarget
         _                       -> spec
 
-patchCCallTarget :: PackageKey -> CCallTarget -> CCallTarget
-patchCCallTarget packageKey callTarget =
+patchCCallTarget :: UnitId -> CCallTarget -> CCallTarget
+patchCCallTarget unitId callTarget =
   case callTarget of
-  StaticTarget label Nothing isFun -> StaticTarget label (Just packageKey) isFun
-  _                                -> callTarget
+  StaticTarget src label Nothing isFun
+                              -> StaticTarget src label (Just unitId) isFun
+  _                           -> callTarget
 
 {-
 *********************************************************
@@ -441,62 +463,239 @@ rnSrcInstDecl (ClsInstD { cid_inst = cid })
   = do { (cid', fvs) <- rnClsInstDecl cid
        ; return (ClsInstD { cid_inst = cid' }, fvs) }
 
+-- | Warn about non-canonical typeclass instance declarations
+--
+-- A "non-canonical" instance definition can occur for instances of a
+-- class which redundantly defines an operation its superclass
+-- provides as well (c.f. `return`/`pure`). In such cases, a canonical
+-- instance is one where the subclass inherits its method
+-- implementation from its superclass instance (usually the subclass
+-- has a default method implementation to that effect). Consequently,
+-- a non-canonical instance occurs when this is not the case.
+--
+-- See also descriptions of 'checkCanonicalMonadInstances' and
+-- 'checkCanonicalMonoidInstances'
+checkCanonicalInstances :: Name -> LHsSigType Name -> LHsBinds Name -> RnM ()
+checkCanonicalInstances cls poly_ty mbinds = do
+    whenWOptM Opt_WarnNonCanonicalMonadInstances
+        checkCanonicalMonadInstances
+
+    whenWOptM Opt_WarnNonCanonicalMonadFailInstances
+        checkCanonicalMonadFailInstances
+
+    whenWOptM Opt_WarnNonCanonicalMonoidInstances
+        checkCanonicalMonoidInstances
+
+  where
+    -- | Warn about unsound/non-canonical 'Applicative'/'Monad' instance
+    -- declarations. Specifically, the following conditions are verified:
+    --
+    -- In 'Monad' instances declarations:
+    --
+    --  * If 'return' is overridden it must be canonical (i.e. @return = pure@)
+    --  * If '(>>)' is overridden it must be canonical (i.e. @(>>) = (*>)@)
+    --
+    -- In 'Applicative' instance declarations:
+    --
+    --  * Warn if 'pure' is defined backwards (i.e. @pure = return@).
+    --  * Warn if '(*>)' is defined backwards (i.e. @(*>) = (>>)@).
+    --
+    checkCanonicalMonadInstances
+      | cls == applicativeClassName  = do
+          forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpan loc $ do
+              case mbind of
+                  FunBind { fun_id = L _ name, fun_matches = mg }
+                      | name == pureAName, isAliasMG mg == Just returnMName
+                      -> addWarnNonCanonicalMethod1
+                            Opt_WarnNonCanonicalMonadInstances "pure" "return"
+
+                      | name == thenAName, isAliasMG mg == Just thenMName
+                      -> addWarnNonCanonicalMethod1
+                            Opt_WarnNonCanonicalMonadInstances "(*>)" "(>>)"
+
+                  _ -> return ()
+
+      | cls == monadClassName  = do
+          forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpan loc $ do
+              case mbind of
+                  FunBind { fun_id = L _ name, fun_matches = mg }
+                      | name == returnMName, isAliasMG mg /= Just pureAName
+                      -> addWarnNonCanonicalMethod2
+                            Opt_WarnNonCanonicalMonadInstances "return" "pure"
+
+                      | name == thenMName, isAliasMG mg /= Just thenAName
+                      -> addWarnNonCanonicalMethod2
+                            Opt_WarnNonCanonicalMonadInstances "(>>)" "(*>)"
+
+                  _ -> return ()
+
+      | otherwise = return ()
+
+    -- | Warn about unsound/non-canonical 'Monad'/'MonadFail' instance
+    -- declarations. Specifically, the following conditions are verified:
+    --
+    -- In 'Monad' instances declarations:
+    --
+    --  * If 'fail' is overridden it must be canonical
+    --    (i.e. @fail = Control.Monad.Fail.fail@)
+    --
+    -- In 'MonadFail' instance declarations:
+    --
+    --  * Warn if 'fail' is defined backwards
+    --    (i.e. @fail = Control.Monad.fail@).
+    --
+    checkCanonicalMonadFailInstances
+      | cls == monadFailClassName  = do
+          forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpan loc $ do
+              case mbind of
+                  FunBind { fun_id = L _ name, fun_matches = mg }
+                      | name == failMName, isAliasMG mg == Just failMName_preMFP
+                      -> addWarnNonCanonicalMethod1
+                            Opt_WarnNonCanonicalMonadFailInstances "fail"
+                            "Control.Monad.fail"
+
+                  _ -> return ()
+
+      | cls == monadClassName  = do
+          forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpan loc $ do
+              case mbind of
+                  FunBind { fun_id = L _ name, fun_matches = mg }
+                      | name == failMName_preMFP, isAliasMG mg /= Just failMName
+                      -> addWarnNonCanonicalMethod2
+                            Opt_WarnNonCanonicalMonadFailInstances "fail"
+                            "Control.Monad.Fail.fail"
+                  _ -> return ()
+
+      | otherwise = return ()
+
+    -- | Check whether Monoid(mappend) is defined in terms of
+    -- Semigroup((<>)) (and not the other way round). Specifically,
+    -- the following conditions are verified:
+    --
+    -- In 'Monoid' instances declarations:
+    --
+    --  * If 'mappend' is overridden it must be canonical
+    --    (i.e. @mappend = (<>)@)
+    --
+    -- In 'Semigroup' instance declarations:
+    --
+    --  * Warn if '(<>)' is defined backwards (i.e. @(<>) = mappend@).
+    --
+    checkCanonicalMonoidInstances
+      | cls == semigroupClassName  = do
+          forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpan loc $ do
+              case mbind of
+                  FunBind { fun_id = L _ name, fun_matches = mg }
+                      | name == sappendName, isAliasMG mg == Just mappendName
+                      -> addWarnNonCanonicalMethod1
+                            Opt_WarnNonCanonicalMonoidInstances "(<>)" "mappend"
+
+                  _ -> return ()
+
+      | cls == monoidClassName  = do
+          forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpan loc $ do
+              case mbind of
+                  FunBind { fun_id = L _ name, fun_matches = mg }
+                      | name == mappendName, isAliasMG mg /= Just sappendName
+                      -> addWarnNonCanonicalMethod2NoDefault
+                            Opt_WarnNonCanonicalMonoidInstances "mappend" "(<>)"
+
+                  _ -> return ()
+
+      | otherwise = return ()
+
+    -- | test whether MatchGroup represents a trivial \"lhsName = rhsName\"
+    -- binding, and return @Just rhsName@ if this is the case
+    isAliasMG :: MatchGroup Name (LHsExpr Name) -> Maybe Name
+    isAliasMG MG {mg_alts = L _ [L _ (Match { m_pats = [], m_grhss = grhss })]}
+        | GRHSs [L _ (GRHS [] body)] lbinds <- grhss
+        , L _ EmptyLocalBinds <- lbinds
+        , L _ (HsVar (L _ rhsName)) <- body  = Just rhsName
+    isAliasMG _ = Nothing
+
+    -- got "lhs = rhs" but expected something different
+    addWarnNonCanonicalMethod1 flag lhs rhs = do
+        addWarn (Reason flag) $ vcat
+                       [ text "Noncanonical" <+>
+                         quotes (text (lhs ++ " = " ++ rhs)) <+>
+                         text "definition detected"
+                       , instDeclCtxt1 poly_ty
+                       , text "Move definition from" <+>
+                         quotes (text rhs) <+>
+                         text "to" <+> quotes (text lhs)
+                       ]
+
+    -- expected "lhs = rhs" but got something else
+    addWarnNonCanonicalMethod2 flag lhs rhs = do
+        addWarn (Reason flag) $ vcat
+                       [ text "Noncanonical" <+>
+                         quotes (text lhs) <+>
+                         text "definition detected"
+                       , instDeclCtxt1 poly_ty
+                       , text "Either remove definition for" <+>
+                         quotes (text lhs) <+> text "or define as" <+>
+                         quotes (text (lhs ++ " = " ++ rhs))
+                       ]
+
+    -- like above, but method has no default impl
+    addWarnNonCanonicalMethod2NoDefault flag lhs rhs = do
+        addWarn (Reason flag) $ vcat
+                       [ text "Noncanonical" <+>
+                         quotes (text lhs) <+>
+                         text "definition detected"
+                       , instDeclCtxt1 poly_ty
+                       , text "Define as" <+>
+                         quotes (text (lhs ++ " = " ++ rhs))
+                       ]
+
+    -- stolen from TcInstDcls
+    instDeclCtxt1 :: LHsSigType Name -> SDoc
+    instDeclCtxt1 hs_inst_ty
+      = inst_decl_ctxt (ppr (getLHsInstDeclHead hs_inst_ty))
+
+    inst_decl_ctxt :: SDoc -> SDoc
+    inst_decl_ctxt doc = hang (text "in the instance declaration for")
+                         2 (quotes doc <> text ".")
+
+
 rnClsInstDecl :: ClsInstDecl RdrName -> RnM (ClsInstDecl Name, FreeVars)
 rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
                            , cid_sigs = uprags, cid_tyfam_insts = ats
                            , cid_overlap_mode = oflag
                            , cid_datafam_insts = adts })
-        -- Used for both source and interface file decls
-  = do { (inst_ty', inst_fvs) <- rnLHsInstType (text "In an instance declaration") inst_ty
-       ; case splitLHsInstDeclTy_maybe inst_ty' of {
-           Nothing -> return (ClsInstDecl { cid_poly_ty = inst_ty', cid_binds = emptyLHsBinds
-                                          , cid_sigs = [], cid_tyfam_insts = []
-                                          , cid_overlap_mode = oflag
-                                          , cid_datafam_insts = [] }
-                             , inst_fvs) ;
-           Just (inst_tyvars, _, L _ cls,_) ->
-
-    do { let (spec_inst_prags, other_sigs) = partition isSpecInstLSig uprags
-             ktv_names = hsLKiTyVarNames inst_tyvars
+  = do { (inst_ty', inst_fvs) <- rnLHsInstType (text "an instance declaration") inst_ty
+       ; let (ktv_names, _, head_ty') = splitLHsInstDeclTy inst_ty'
+       ; let cls = case hsTyGetAppHead_maybe head_ty' of
+                     Nothing -> mkUnboundName (mkTcOccFS (fsLit "<class>"))
+                     Just (L _ cls, _) -> cls
+                     -- rnLHsInstType has added an error message
+                     -- if hsTyGetAppHead_maybe fails
+
+          -- Rename the bindings
+          -- The typechecker (not the renamer) checks that all
+          -- the bindings are for the right class
+          -- (Slightly strangely) when scoped type variables are on, the
+          -- forall-d tyvars scope over the method bindings too
+       ; (mbinds', uprags', meth_fvs) <- rnMethodBinds False cls ktv_names mbinds uprags
+
+       ; checkCanonicalInstances cls inst_ty' mbinds'
 
        -- Rename the associated types, and type signatures
        -- Both need to have the instance type variables in scope
-       ; traceRn (text "rnSrcInstDecl"  <+> ppr inst_ty' $$ ppr inst_tyvars $$ ppr ktv_names)
-       ; ((ats', adts', other_sigs'), more_fvs)
+       ; traceRn (text "rnSrcInstDecl"  <+> ppr inst_ty' $$ ppr ktv_names)
+       ; ((ats', adts'), more_fvs)
              <- extendTyVarEnvFVRn ktv_names $
-                do { (ats',  at_fvs)  <- rnATInstDecls rnTyFamInstDecl cls inst_tyvars ats
-                   ; (adts', adt_fvs) <- rnATInstDecls rnDataFamInstDecl cls inst_tyvars adts
-                   ; (other_sigs', sig_fvs) <- renameSigs (InstDeclCtxt cls) other_sigs
-                   ; return ( (ats', adts', other_sigs')
-                            , at_fvs `plusFV` adt_fvs `plusFV` sig_fvs) }
-
-        -- Rename the bindings
-        -- The typechecker (not the renamer) checks that all
-        -- the bindings are for the right class
-        -- (Slightly strangely) when scoped type variables are on, the
-        -- forall-d tyvars scope over the method bindings too
-       ; (mbinds', meth_fvs) <- extendTyVarEnvForMethodBinds ktv_names $
-                                rnMethodBinds cls (mkSigTvFn other_sigs')
-                                                  mbinds
-
-        -- Rename the SPECIALISE instance pramas
-        -- Annoyingly the type variables are not in scope here,
-        -- so that      instance Eq a => Eq (T a) where
-        --                      {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
-        -- works OK. That's why we did the partition game above
-        --
-       ; (spec_inst_prags', spec_inst_fvs)
-             <- renameSigs (InstDeclCtxt cls) spec_inst_prags
-
-       ; let uprags' = spec_inst_prags' ++ other_sigs'
-             all_fvs = meth_fvs `plusFV` more_fvs
-                          `plusFV` spec_inst_fvs
-                          `plusFV` inst_fvs
+                do { (ats',  at_fvs)  <- rnATInstDecls rnTyFamInstDecl cls ktv_names ats
+                   ; (adts', adt_fvs) <- rnATInstDecls rnDataFamInstDecl cls ktv_names adts
+                   ; return ( (ats', adts'), at_fvs `plusFV` adt_fvs) }
+
+       ; let all_fvs = meth_fvs `plusFV` more_fvs
+                                `plusFV` inst_fvs
        ; return (ClsInstDecl { cid_poly_ty = inst_ty', cid_binds = mbinds'
                              , cid_sigs = uprags', cid_tyfam_insts = ats'
                              , cid_overlap_mode = oflag
                              , cid_datafam_insts = adts' },
-                 all_fvs) } } }
+                 all_fvs) }
              -- We return the renamed associated data type declarations so
              -- that they can be entered into the list of type declarations
              -- for the binding group, but we also keep a copy in the instance.
@@ -511,48 +710,67 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
 rnFamInstDecl :: HsDocContext
               -> Maybe (Name, [Name])
               -> Located RdrName
-              -> [LHsType RdrName]
+              -> HsTyPats RdrName
               -> rhs
               -> (HsDocContext -> rhs -> RnM (rhs', FreeVars))
-              -> RnM (Located Name, HsWithBndrs Name [LHsType Name], rhs',
-                      FreeVars)
-rnFamInstDecl doc mb_cls tycon pats payload rnPayload
+              -> RnM (Located Name, HsTyPats Name, rhs', FreeVars)
+rnFamInstDecl doc mb_cls tycon (HsIB { hsib_body = pats }) payload rnPayload
   = do { tycon'   <- lookupFamInstName (fmap fst mb_cls) tycon
        ; let loc = case pats of
                      []             -> pprPanic "rnFamInstDecl" (ppr tycon)
                      (L loc _ : []) -> loc
                      (L loc _ : ps) -> combineSrcSpans loc (getLoc (last ps))
-             (kv_rdr_names, tv_rdr_names) = extractHsTysRdrTyVars pats
 
+       ; pat_kity_vars_with_dups <- extractHsTysRdrTyVarsDups pats
+             -- Use the "...Dups" form because it's needed
+             -- below to report unsed binder on the LHS
+       ; var_names <- mapM (newTyVarNameRn mb_cls . L loc . unLoc) $
+                      freeKiTyVarsAllVars $
+                      rmDupsInRdrTyVars pat_kity_vars_with_dups
 
-       ; rdr_env  <- getLocalRdrEnv
-       ; kv_names <- mapM (newTyVarNameRn mb_cls rdr_env loc) kv_rdr_names
-       ; tv_names <- mapM (newTyVarNameRn mb_cls rdr_env loc) tv_rdr_names
              -- All the free vars of the family patterns
              -- with a sensible binding location
        ; ((pats', payload'), fvs)
-              <- bindLocalNamesFV kv_names $
-                 bindLocalNamesFV tv_names $
-                 do { (pats', pat_fvs) <- rnLHsTypes doc pats
+              <- bindLocalNamesFV var_names $
+                 do { (pats', pat_fvs) <- rnLHsTypes (FamPatCtx tycon) pats
                     ; (payload', rhs_fvs) <- rnPayload doc payload
 
+                       -- Report unused binders on the LHS
+                       -- See Note [Unused type variables in family instances]
+                    ; let groups :: [[Located RdrName]]
+                          groups = equivClasses cmpLocated $
+                                   freeKiTyVarsAllVars pat_kity_vars_with_dups
+                    ; tv_nms_dups <- mapM (lookupOccRn . unLoc) $
+                                     [ tv | (tv:_:_) <- groups ]
+                          -- Add to the used variables any variables that
+                          -- appear *more than once* on the LHS
+                          -- e.g.   F a Int a = Bool
+                    ; let tv_nms_used = extendNameSetList rhs_fvs tv_nms_dups
+                    ; warnUnusedTypePatterns var_names tv_nms_used
+
                          -- See Note [Renaming associated types]
-                    ; let lhs_names = mkNameSet kv_names `unionNameSet` mkNameSet tv_names
-                          bad_tvs = case mb_cls of
+                    ; let bad_tvs = case mb_cls of
                                       Nothing           -> []
                                       Just (_,cls_tkvs) -> filter is_bad cls_tkvs
+                          var_name_set = mkNameSet var_names
 
                           is_bad cls_tkv = cls_tkv `elemNameSet` rhs_fvs
-                                        && not (cls_tkv `elemNameSet` lhs_names)
+                                        && not (cls_tkv `elemNameSet` var_name_set)
 
                     ; unless (null bad_tvs) (badAssocRhs bad_tvs)
                     ; return ((pats', payload'), rhs_fvs `plusFV` pat_fvs) }
 
+       ; let anon_wcs = concatMap collectAnonWildCards pats'
+             all_ibs  = anon_wcs ++ var_names
+                        -- all_ibs: include anonymous wildcards in the implicit
+                        -- binders In a type pattern they behave just like any
+                        -- other type variable except for being anoymous.  See
+                        -- Note [Wildcards in family instances]
+             all_fvs  = fvs `addOneFV` unLoc tycon'
 
-       ; let all_fvs = fvs `addOneFV` unLoc tycon'
        ; return (tycon',
-                 HsWB { hswb_cts = pats', hswb_kvs = kv_names,
-                        hswb_tvs = tv_names, hswb_wcs = [] },
+                 HsIB { hsib_body = pats'
+                      , hsib_vars = all_ibs },
                  payload',
                  all_fvs) }
              -- type instance => use, hence addOneFV
@@ -569,7 +787,7 @@ rnTyFamInstEqn :: Maybe (Name, [Name])
                -> TyFamInstEqn RdrName
                -> RnM (TyFamInstEqn Name, FreeVars)
 rnTyFamInstEqn mb_cls (TyFamEqn { tfe_tycon = tycon
-                                , tfe_pats  = HsWB { hswb_cts = pats }
+                                , tfe_pats  = pats
                                 , tfe_rhs   = rhs })
   = do { (tycon', pats', rhs', fvs) <-
            rnFamInstDecl (TySynCtx tycon) mb_cls tycon pats rhs rnTySyn
@@ -583,7 +801,7 @@ rnTyFamDefltEqn :: Name
 rnTyFamDefltEqn cls (TyFamEqn { tfe_tycon = tycon
                               , tfe_pats  = tyvars
                               , tfe_rhs   = rhs })
-  = bindHsTyVars ctx (Just cls) [] tyvars $ \ tyvars' ->
+  = bindHsQTyVars ctx Nothing (Just cls) [] tyvars $ \ tyvars' ->
     do { tycon'      <- lookupFamInstName (Just cls) tycon
        ; (rhs', fvs) <- rnLHsType ctx rhs
        ; return (TyFamEqn { tfe_tycon = tycon'
@@ -596,7 +814,7 @@ rnDataFamInstDecl :: Maybe (Name, [Name])
                   -> DataFamInstDecl RdrName
                   -> RnM (DataFamInstDecl Name, FreeVars)
 rnDataFamInstDecl mb_cls (DataFamInstDecl { dfid_tycon = tycon
-                                          , dfid_pats  = HsWB { hswb_cts = pats }
+                                          , dfid_pats  = pats
                                           , dfid_defn  = defn })
   = do { (tycon', pats', defn', fvs) <-
            rnFamInstDecl (TyDataCtx tycon) mb_cls tycon pats defn rnDataDefn
@@ -618,7 +836,7 @@ rnATInstDecls :: (Maybe (Name, [Name]) ->    -- The function that renames
                   decl RdrName ->            -- an instance. rnTyFamInstDecl
                   RnM (decl Name, FreeVars)) -- or rnDataFamInstDecl
               -> Name      -- Class
-              -> LHsTyVarBndrs Name
+              -> [Name]
               -> [Located (decl RdrName)]
               -> RnM ([Located (decl Name)], FreeVars)
 -- Used for data and type family defaults in a class decl
@@ -626,13 +844,50 @@ rnATInstDecls :: (Maybe (Name, [Name]) ->    -- The function that renames
 --
 -- NB: We allow duplicate associated-type decls;
 --     See Note [Associated type instances] in TcInstDcls
-rnATInstDecls rnFun cls hs_tvs at_insts
+rnATInstDecls rnFun cls tv_ns at_insts
   = rnList (rnFun (Just (cls, tv_ns))) at_insts
-  where
-    tv_ns = hsLKiTyVarNames hs_tvs
     -- See Note [Renaming associated types]
 
-{-
+{- Note [Wildcards in family instances]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Wild cards can be used in type/data family instance declarations to indicate
+that the name of a type variable doesn't matter. Each wild card will be
+replaced with a new unique type variable. For instance:
+
+    type family F a b :: *
+    type instance F Int _ = Int
+
+is the same as
+
+    type family F a b :: *
+    type instance F Int b = Int
+
+This is implemented as follows: during renaming anonymous wild cards
+'_' are given freshly generated names. These names are collected after
+renaming (rnFamInstDecl) and used to make new type variables during
+type checking (tc_fam_ty_pats). One should not confuse these wild
+cards with the ones from partial type signatures. The latter generate
+fresh meta-variables whereas the former generate fresh skolems.
+
+Note [Unused type variables in family instances]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When the flag -fwarn-unused-type-patterns is on, the compiler reports warnings
+about unused type variables. (rnFamInstDecl) A type variable is considered
+used
+ * when it is either occurs on the RHS of the family instance, or
+   e.g.   type instance F a b = a    -- a is used on the RHS
+
+ * it occurs multiple times in the patterns on the LHS
+   e.g.   type instance F a a = Int  -- a appears more than once on LHS
+
+As usual, the warnings are not reported for for type variables with names
+beginning with an underscore.
+
+Extra-constraints wild cards are not supported in type/data family
+instance declarations.
+
+Relevant tickets: #3699, #10586, #10982 and #11451.
+
 Note [Renaming associated types]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Check that the RHS of the decl mentions only type variables
@@ -661,18 +916,6 @@ can all be in scope (Trac #5862):
 Here 'k' is in scope in the kind signature, just like 'x'.
 -}
 
-extendTyVarEnvForMethodBinds :: [Name]
-                             -> RnM (LHsBinds Name, FreeVars)
-                             -> RnM (LHsBinds Name, FreeVars)
--- For the method bindings in class and instance decls, we extend
--- the type variable environment iff -XScopedTypeVariables
-
-extendTyVarEnvForMethodBinds ktv_names thing_inside
-  = do  { scoped_tvs <- xoptM Opt_ScopedTypeVariables
-        ; if scoped_tvs then
-                extendTyVarEnvFVRn ktv_names thing_inside
-          else
-                thing_inside }
 
 {-
 *********************************************************
@@ -684,15 +927,15 @@ extendTyVarEnvForMethodBinds ktv_names thing_inside
 
 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
 rnSrcDerivDecl (DerivDecl ty overlap)
-  = do { standalone_deriv_ok <- xoptM Opt_StandaloneDeriving
+  = do { standalone_deriv_ok <- xoptM LangExt.StandaloneDeriving
        ; unless standalone_deriv_ok (addErr standaloneDerivErr)
        ; (ty', fvs) <- rnLHsInstType (text "In a deriving declaration") ty
        ; return (DerivDecl ty' overlap, fvs) }
 
 standaloneDerivErr :: SDoc
 standaloneDerivErr
-  = hang (ptext (sLit "Illegal standalone deriving declaration"))
-       2 (ptext (sLit "Use StandaloneDeriving to enable this extension"))
+  = hang (text "Illegal standalone deriving declaration")
+       2 (text "Use StandaloneDeriving to enable this extension")
 
 {-
 *********************************************************
@@ -702,16 +945,21 @@ standaloneDerivErr
 *********************************************************
 -}
 
+rnHsRuleDecls :: RuleDecls RdrName -> RnM (RuleDecls Name, FreeVars)
+rnHsRuleDecls (HsRules src rules)
+  = do { (rn_rules,fvs) <- rnList rnHsRuleDecl rules
+       ; return (HsRules src rn_rules,fvs) }
+
 rnHsRuleDecl :: RuleDecl RdrName -> RnM (RuleDecl Name, FreeVars)
 rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
   = do { let rdr_names_w_loc = map get_var vars
        ; checkDupRdrNames rdr_names_w_loc
        ; checkShadowedRdrNames rdr_names_w_loc
        ; names <- newLocalBndrsRn rdr_names_w_loc
-       ; bindHsRuleVars (unLoc rule_name) vars names $ \ vars' ->
+       ; bindHsRuleVars (snd $ unLoc rule_name) vars names $ \ vars' ->
     do { (lhs', fv_lhs') <- rnLExpr lhs
        ; (rhs', fv_rhs') <- rnLExpr rhs
-       ; checkValidRule (unLoc rule_name) names lhs' fv_lhs'
+       ; checkValidRule (snd $ unLoc rule_name) names lhs' fv_lhs'
        ; return (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
                  fv_lhs' `plusFV` fv_rhs') } }
   where
@@ -732,7 +980,7 @@ bindHsRuleVars rule_name vars names thing_inside
         thing_inside (L l (RuleBndr (L loc n)) : vars')
 
     go (L l (RuleBndrSig (L loc _) bsig) : vars) (n : ns) thing_inside
-      = rnHsBndrSig doc bsig $ \ bsig' ->
+      = rnHsSigWcTypeScoped doc bsig $ \ bsig' ->
         go vars ns $ \ vars' ->
         thing_inside (L l (RuleBndrSig (L loc n) bsig') : vars')
 
@@ -768,7 +1016,7 @@ checkValidRule rule_name ids lhs' fv_lhs'
 
 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
 -- Nothing => OK
--- Just e  => Not ok, and e is the offending expression
+-- Just e  => Not ok, and e is the offending sub-expression
 validRuleLhs foralls lhs
   = checkl lhs
   where
@@ -776,7 +1024,8 @@ validRuleLhs foralls lhs
 
     check (OpApp e1 op _ e2)              = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
     check (HsApp e1 e2)                   = checkl e1 `mplus` checkl_e e2
-    check (HsVar v) | v `notElem` foralls = Nothing
+    check (HsAppType e _)                 = checkl e
+    check (HsVar (L _ v)) | v `notElem` foralls = Nothing
     check other                           = Just other  -- Failure
 
         -- Check an argument
@@ -799,17 +1048,21 @@ validRuleLhs foralls lhs
 
 badRuleVar :: FastString -> Name -> SDoc
 badRuleVar name var
-  = sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon,
-         ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+>
-                ptext (sLit "does not appear on left hand side")]
+  = sep [text "Rule" <+> doubleQuotes (ftext name) <> colon,
+         text "Forall'd variable" <+> quotes (ppr var) <+>
+                text "does not appear on left hand side"]
 
 badRuleLhsErr :: FastString -> LHsExpr Name -> HsExpr Name -> SDoc
 badRuleLhsErr name lhs bad_e
-  = sep [ptext (sLit "Rule") <+> ftext name <> colon,
-         nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e,
-                       ptext (sLit "in left-hand side:") <+> ppr lhs])]
+  = sep [text "Rule" <+> pprRuleName name <> colon,
+         nest 4 (vcat [err,
+                       text "in left-hand side:" <+> ppr lhs])]
     $$
-    ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd")
+    text "LHS must be of form (f e1 .. en) where f is not forall'd"
+  where
+    err = case bad_e of
+            HsUnboundVar occ -> text "Not in scope:" <+> ppr occ
+            _ -> text "Illegal expression:" <+> ppr bad_e
 
 {-
 *********************************************************
@@ -822,40 +1075,40 @@ badRuleLhsErr name lhs bad_e
 rnHsVectDecl :: VectDecl RdrName -> RnM (VectDecl Name, FreeVars)
 -- FIXME: For the moment, the right-hand side is restricted to be a variable as we cannot properly
 --        typecheck a complex right-hand side without invoking 'vectType' from the vectoriser.
-rnHsVectDecl (HsVect var rhs@(L _ (HsVar _)))
+rnHsVectDecl (HsVect var rhs@(L _ (HsVar _)))
   = do { var' <- lookupLocatedOccRn var
        ; (rhs', fv_rhs) <- rnLExpr rhs
-       ; return (HsVect var' rhs', fv_rhs `addOneFV` unLoc var')
+       ; return (HsVect var' rhs', fv_rhs `addOneFV` unLoc var')
        }
-rnHsVectDecl (HsVect _var _rhs)
+rnHsVectDecl (HsVect _ _var _rhs)
   = failWith $ vcat
-               [ ptext (sLit "IMPLEMENTATION RESTRICTION: right-hand side of a VECTORISE pragma")
-               , ptext (sLit "must be an identifier")
+               [ text "IMPLEMENTATION RESTRICTION: right-hand side of a VECTORISE pragma"
+               , text "must be an identifier"
                ]
-rnHsVectDecl (HsNoVect var)
+rnHsVectDecl (HsNoVect var)
   = do { var' <- lookupLocatedTopBndrRn var           -- only applies to local (not imported) names
-       ; return (HsNoVect var', unitFV (unLoc var'))
+       ; return (HsNoVect var', unitFV (unLoc var'))
        }
-rnHsVectDecl (HsVectTypeIn isScalar tycon Nothing)
+rnHsVectDecl (HsVectTypeIn isScalar tycon Nothing)
   = do { tycon' <- lookupLocatedOccRn tycon
-       ; return (HsVectTypeIn isScalar tycon' Nothing, unitFV (unLoc tycon'))
+       ; return (HsVectTypeIn isScalar tycon' Nothing, unitFV (unLoc tycon'))
        }
-rnHsVectDecl (HsVectTypeIn isScalar tycon (Just rhs_tycon))
+rnHsVectDecl (HsVectTypeIn isScalar tycon (Just rhs_tycon))
   = do { tycon'     <- lookupLocatedOccRn tycon
        ; rhs_tycon' <- lookupLocatedOccRn rhs_tycon
-       ; return ( HsVectTypeIn isScalar tycon' (Just rhs_tycon')
+       ; return ( HsVectTypeIn isScalar tycon' (Just rhs_tycon')
                 , mkFVs [unLoc tycon', unLoc rhs_tycon'])
        }
 rnHsVectDecl (HsVectTypeOut _ _ _)
   = panic "RnSource.rnHsVectDecl: Unexpected 'HsVectTypeOut'"
-rnHsVectDecl (HsVectClassIn cls)
+rnHsVectDecl (HsVectClassIn cls)
   = do { cls' <- lookupLocatedOccRn cls
-       ; return (HsVectClassIn cls', unitFV (unLoc cls'))
+       ; return (HsVectClassIn cls', unitFV (unLoc cls'))
        }
 rnHsVectDecl (HsVectClassOut _)
   = panic "RnSource.rnHsVectDecl: Unexpected 'HsVectClassOut'"
 rnHsVectDecl (HsVectInstIn instTy)
-  = do { (instTy', fvs) <- rnLHsInstType (text "In a VECTORISE pragma") instTy
+  = do { (instTy', fvs) <- rnLHsInstType (text "a VECTORISE pragma") instTy
        ; return (HsVectInstIn instTy', fvs)
        }
 rnHsVectDecl (HsVectInstOut _)
@@ -886,53 +1139,76 @@ Note [Extra dependencies from .hs-boot files]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider the following case:
 
+A.hs-boot
   module A where
-    import B
-    data A1 = A1 B1
+    data A1
 
+B.hs
   module B where
     import {-# SOURCE #-} A
     type DisguisedA1 = A1
     data B1 = B1 DisguisedA1
 
-We do not follow type synonyms when building the dependencies for each datatype,
-so we will not find out that B1 really depends on A1 (which means it depends on
-itself). To handle this problem, at the moment we add dependencies to everything
-that comes from an .hs-boot file. But we don't add those dependencies to
-everything. Imagine module B above had another datatype declaration:
+A.hs
+  module A where
+    import B
+    data A2 = A2 A1
+    data A1 = A1 B1
+
+Here A1 is really recursive (via B1), but we won't see that easily when
+doing dependency analysis when compiling A.hs
+
+To handle this problem, we add a dependency
+  - from every local declaration
+  - to everything that comes from this module's .hs-boot file.
+In this case, we'll ad and edges
+  - from A2 to A1 (but that edge is there already)
+  - from A1 to A1 (which is new)
 
-  data B2 = B2 Int
+Well, not quite *every* declaration. Imagine module A
+above had another datatype declaration:
 
-Even though B2 has a dependency (on Int), all its dependencies are from things
+  data A3 = A3 Int
+
+Even though A3 has a dependency (on Int), all its dependencies are from things
 that live on other packages. Since we don't have mutual dependencies across
-packages, it is safe not to add the dependencies on the .hs-boot stuff to B2.
+packages, it is safe not to add the dependencies on the .hs-boot stuff to A2.
+
+Hence function Name.thisPackageImport.
 
 See also Note [Grouping of type and class declarations] in TcTyClsDecls.
 -}
 
-isInPackage :: PackageKey -> Name -> Bool
-isInPackage pkgId nm = case nameModule_maybe nm of
-                         Nothing -> False
-                         Just m  -> pkgId == modulePackageKey m
--- We use nameModule_maybe because we might be in a TH splice, in which case
--- there is no module name. In that case we cannot have mutual dependencies,
--- so it's fine to return False here.
 
-rnTyClDecls :: [Name] -> [TyClGroup RdrName]
+rnTyClDecls :: [TyClGroup RdrName]
             -> RnM ([TyClGroup Name], FreeVars)
--- Rename the declarations and do depedency analysis on them
-rnTyClDecls extra_deps tycl_ds
-  = do { ds_w_fvs <- mapM (wrapLocFstM rnTyClDecl) (tyClGroupConcat tycl_ds)
-       ; role_annot_env <- rnRoleAnnots (concatMap group_roles tycl_ds)
-       ; thisPkg  <- fmap thisPackage getDynFlags
-       ; let add_boot_deps :: FreeVars -> FreeVars
+-- Rename the declarations and do dependency analysis on them
+rnTyClDecls tycl_ds
+  = do { ds_w_fvs       <- mapM (wrapLocFstM rnTyClDecl) (tyClGroupConcat tycl_ds)
+       ; let decl_names = mkNameSet (map (tcdName . unLoc . fst) ds_w_fvs)
+       ; role_annot_env <- rnRoleAnnots decl_names (concatMap group_roles tycl_ds)
+       ; tcg_env        <- getGblEnv
+       ; let this_mod  = tcg_mod tcg_env
+             boot_info = tcg_self_boot tcg_env
+
+             add_boot_deps :: [(LTyClDecl Name, FreeVars)] -> [(LTyClDecl Name, FreeVars)]
              -- See Note [Extra dependencies from .hs-boot files]
-             add_boot_deps fvs | any (isInPackage thisPkg) (nameSetElems fvs)
-                               = fvs `plusFV` mkFVs extra_deps
-                               | otherwise
-                               = fvs
+             add_boot_deps ds_w_fvs
+               = case boot_info of
+                     SelfBoot { sb_tcs = tcs } | not (isEmptyNameSet tcs)
+                        -> map (add_one tcs) ds_w_fvs
+                     _  -> ds_w_fvs
+
+             add_one :: NameSet -> (LTyClDecl Name, FreeVars) -> (LTyClDecl Name, FreeVars)
+             add_one tcs pr@(decl,fvs)
+                | has_local_imports fvs = (decl, fvs `plusFV` tcs)
+                | otherwise             = pr
 
-             ds_w_fvs' = mapSnd add_boot_deps ds_w_fvs
+             has_local_imports fvs
+                 = foldNameSet ((||) . nameIsHomePackageImport this_mod)
+                               False fvs
+
+             ds_w_fvs' = add_boot_deps ds_w_fvs
 
              sccs :: [SCC (LTyClDecl Name)]
              sccs = depAnalTyClDecls ds_w_fvs'
@@ -971,10 +1247,10 @@ rnTyClDecl (FamDecl { tcdFam = decl })
 
 rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, tcdRhs = rhs })
   = do { tycon' <- lookupLocatedTopBndrRn tycon
-       ; let kvs = fst (extractHsTyRdrTyVars rhs)
-             doc = TySynCtx tycon
+       ; kvs <- freeKiTyVarsKindVars <$> extractHsTyRdrTyVars rhs
+       ; let doc = TySynCtx tycon
        ; traceRn (text "rntycl-ty" <+> ppr tycon <+> ppr kvs)
-       ; ((tyvars', rhs'), fvs) <- bindHsTyVars doc Nothing kvs tyvars $
+       ; ((tyvars', rhs'), fvs) <- bindHsQTyVars doc Nothing Nothing kvs tyvars $
                                     \ tyvars' ->
                                     do { (rhs', fvs) <- rnTySyn doc rhs
                                        ; return ((tyvars', rhs'), fvs) }
@@ -985,37 +1261,35 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, tcdRhs = rhs })
 -- both top level and (for an associated type) in an instance decl
 rnTyClDecl (DataDecl { tcdLName = tycon, tcdTyVars = tyvars, tcdDataDefn = defn })
   = do { tycon' <- lookupLocatedTopBndrRn tycon
-       ; let kvs = extractDataDefnKindVars defn
-             doc = TyDataCtx tycon
+       ; kvs <- extractDataDefnKindVars defn
+       ; let doc = TyDataCtx tycon
        ; traceRn (text "rntycl-data" <+> ppr tycon <+> ppr kvs)
-       ; ((tyvars', defn'), fvs) <- bindHsTyVars doc Nothing kvs tyvars $ \ tyvars' ->
+       ; ((tyvars', defn'), fvs) <- bindHsQTyVars doc Nothing Nothing kvs tyvars $ \ tyvars' ->
                                     do { (defn', fvs) <- rnDataDefn doc defn
                                        ; return ((tyvars', defn'), fvs) }
        ; return (DataDecl { tcdLName = tycon', tcdTyVars = tyvars'
                           , tcdDataDefn = defn', tcdFVs = fvs }, fvs) }
 
-rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = lcls,
-                              tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
-                              tcdMeths = mbinds, tcdATs = ats, tcdATDefs = at_defs,
-                              tcdDocs = docs})
+rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls,
+                        tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
+                        tcdMeths = mbinds, tcdATs = ats, tcdATDefs = at_defs,
+                        tcdDocs = docs})
   = do  { lcls' <- lookupLocatedTopBndrRn lcls
         ; let cls' = unLoc lcls'
               kvs = []  -- No scoped kind vars except those in
                         -- kind signatures on the tyvars
 
         -- Tyvars scope over superclass context and method signatures
-        ; ((tyvars', context', fds', ats', sigs'), stuff_fvs)
-            <- bindHsTyVars cls_doc Nothing kvs tyvars $ \ tyvars' -> do
+        ; ((tyvars', context', fds', ats'), stuff_fvs)
+            <- bindHsQTyVars cls_doc Nothing Nothing kvs tyvars $ \ tyvars' -> do
                   -- Checks for distinct tyvars
              { (context', cxt_fvs) <- rnContext cls_doc context
              ; fds'  <- rnFds fds
                          -- The fundeps have no free variables
-             ; (ats',   fv_ats) <- rnATDecls cls' ats
-             ; (sigs', sig_fvs) <- renameSigs (ClsDeclCtxt cls') sigs
+             ; (ats', fv_ats) <- rnATDecls cls' ats
              ; let fvs = cxt_fvs     `plusFV`
-                         sig_fvs     `plusFV`
                          fv_ats
-             ; return ((tyvars', context', fds', ats', sigs'), fvs) }
+             ; return ((tyvars', context', fds', ats'), fvs) }
 
         ; (at_defs', fv_at_defs) <- rnList (rnTyFamDefltEqn cls') at_defs
 
@@ -1024,7 +1298,8 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = lcls,
 
         -- Check the signatures
         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
-        ; let sig_rdr_names_w_locs = [op | L _ (TypeSig ops _ _) <- sigs, op <- ops]
+        ; let sig_rdr_names_w_locs = [op | L _ (ClassOpSig False ops _) <- sigs
+                                         , op <- ops]
         ; checkDupRdrNames sig_rdr_names_w_locs
                 -- Typechecker is responsible for checking that we only
                 -- give default-method bindings for things in this class.
@@ -1039,12 +1314,11 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = lcls,
         --        op {| a*b |} (a*b)   = ...
         -- we want to name both "x" tyvars with the same unique, so that they are
         -- easy to group together in the typechecker.
-        ; (mbinds', meth_fvs)
-            <- extendTyVarEnvForMethodBinds (hsLKiTyVarNames tyvars') $
+        ; (mbinds', sigs', meth_fvs)
+            <- rnMethodBinds True cls' (hsAllLTyVarNames tyvars') mbinds sigs
                 -- No need to check for duplicate method signatures
                 -- since that is done by RnNames.extendGlobalRdrEnvRn
                 -- and the methods are already in scope
-                 rnMethodBinds cls' (mkSigTvFn sigs') mbinds
 
   -- Haddock docs
         ; docs' <- mapM (wrapLocM rnDocDecl) docs
@@ -1062,13 +1336,14 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = lcls,
 rnTySyn :: HsDocContext -> LHsType RdrName -> RnM (LHsType Name, FreeVars)
 rnTySyn doc rhs = rnLHsType doc rhs
 
--- Renames role annotations, returning them as the values in a NameEnv
+-- Renames role annotations, returning them as the values in a NameEnv
 -- and checks for duplicate role annotations.
 -- It is quite convenient to do both of these in the same place.
 -- See also Note [Role annotations in the renamer]
-rnRoleAnnots :: [LRoleAnnotDecl RdrName]
-                -> RnM (NameEnv (LRoleAnnotDecl Name))
-rnRoleAnnots role_annots
+rnRoleAnnots :: NameSet  -- ^ of the decls in this group
+             -> [LRoleAnnotDecl RdrName]
+             -> RnM (NameEnv (LRoleAnnotDecl Name))
+rnRoleAnnots decl_names role_annots
   = do {  -- check for duplicates *before* renaming, to avoid lumping
           -- together all the unboundNames
          let (no_dups, dup_annots) = removeDups role_annots_cmp role_annots
@@ -1084,8 +1359,11 @@ rnRoleAnnots role_annots
                             , not (isUnboundName name) ] }
   where
     rn_role_annot1 (RoleAnnotDecl tycon roles)
-      = do {  -- the name is an *occurrence*
-             tycon' <- wrapLocM lookupGlobalOccRn tycon
+      = do {  -- the name is an *occurrence*, but look it up only in the
+              -- decls defined in this group (see #10263)
+             tycon' <- lookupSigCtxtOccRn (RoleAnnotCtxt decl_names)
+                                          (text "role annotation")
+                                          tycon
            ; return $ RoleAnnotDecl tycon' roles }
 
 dupRoleAnnotErr :: [LRoleAnnotDecl RdrName] -> RnM ()
@@ -1144,46 +1422,184 @@ rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType
         }
   where
     h98_style = case condecls of  -- Note [Stupid theta]
-                     L _ (ConDecl { con_res = ResTyGADT {} }) : _  -> False
-                     _                                             -> True
+                     L _ (ConDeclGADT {}) : _  -> False
+                     _                         -> True
 
-    rn_derivs Nothing   = return (Nothing, emptyFVs)
-    rn_derivs (Just (L ld ds)) = do { (ds', fvs) <- rnLHsTypes doc ds
-                                    ; return (Just (L ld ds'), fvs) }
+    rn_derivs Nothing
+      = return (Nothing, emptyFVs)
+    rn_derivs (Just (L loc ds))
+      = do { (ds', fvs) <- mapFvRn (rnHsSigType doc) ds
+           ; return (Just (L loc ds'), fvs) }
 
 badGadtStupidTheta :: HsDocContext -> SDoc
 badGadtStupidTheta _
-  = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
-          ptext (sLit "(You can put a context on each contructor, though.)")]
+  = vcat [text "No context is allowed on a GADT-style data declaration",
+          text "(You can put a context on each contructor, though.)"]
 
-rnFamDecl :: Maybe Name
-                    -- Just cls => this FamilyDecl is nested
-                    --             inside an *class decl* for cls
-                    --             used for associated types
+rnFamDecl :: Maybe Name -- Just cls => this FamilyDecl is nested
+                        --             inside an *class decl* for cls
+                        --             used for associated types
           -> FamilyDecl RdrName
           -> RnM (FamilyDecl Name, FreeVars)
 rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars
-                             , fdInfo = info, fdKindSig = kind })
-  = do { ((tycon', tyvars', kind'), fv1) <-
-           bindHsTyVars fmly_doc mb_cls kvs tyvars $ \tyvars' ->
-           do { tycon' <- lookupLocatedTopBndrRn tycon
-              ; (kind', fv_kind) <- rnLHsMaybeKind fmly_doc kind
-              ; return ((tycon', tyvars', kind'), fv_kind) }
+                             , fdInfo = info, fdResultSig = res_sig
+                             , fdInjectivityAnn = injectivity })
+  = do { tycon' <- lookupLocatedTopBndrRn tycon
+       ; kvs <- extractRdrKindSigVars res_sig
+       ; ((tyvars', res_sig', injectivity'), fv1) <-
+            bindHsQTyVars doc Nothing mb_cls kvs tyvars $
+            \ tyvars'@(HsQTvs { hsq_implicit = rn_kvs }) ->
+            do { let rn_sig = rnFamResultSig doc rn_kvs
+               ; (res_sig', fv_kind) <- wrapLocFstM rn_sig res_sig
+               ; injectivity' <- traverse (rnInjectivityAnn tyvars' res_sig')
+                                          injectivity
+               ; return ( (tyvars', res_sig', injectivity') , fv_kind ) }
        ; (info', fv2) <- rn_info info
        ; return (FamilyDecl { fdLName = tycon', fdTyVars = tyvars'
-                            , fdInfo = info', fdKindSig = kind' }
+                            , fdInfo = info', fdResultSig = res_sig'
+                            , fdInjectivityAnn = injectivity' }
                 , fv1 `plusFV` fv2) }
   where
-     fmly_doc = TyFamilyCtx tycon
-     kvs = extractRdrKindSigVars kind
+     doc = TyFamilyCtx tycon
 
-     rn_info (ClosedTypeFamily eqns)
+     ----------------------
+     rn_info (ClosedTypeFamily (Just eqns))
        = do { (eqns', fvs) <- rnList (rnTyFamInstEqn Nothing) eqns
                                                     -- no class context,
-            ; return (ClosedTypeFamily eqns', fvs) }
+            ; return (ClosedTypeFamily (Just eqns'), fvs) }
+     rn_info (ClosedTypeFamily Nothing)
+       = return (ClosedTypeFamily Nothing, emptyFVs)
      rn_info OpenTypeFamily = return (OpenTypeFamily, emptyFVs)
      rn_info DataFamily     = return (DataFamily, emptyFVs)
 
+rnFamResultSig :: HsDocContext
+               -> [Name]   -- kind variables already in scope
+               -> FamilyResultSig RdrName
+               -> RnM (FamilyResultSig Name, FreeVars)
+rnFamResultSig _ _ NoSig
+   = return (NoSig, emptyFVs)
+rnFamResultSig doc _ (KindSig kind)
+   = do { (rndKind, ftvs) <- rnLHsKind doc kind
+        ;  return (KindSig rndKind, ftvs) }
+rnFamResultSig doc kv_names (TyVarSig tvbndr)
+   = do { -- `TyVarSig` tells us that user named the result of a type family by
+          -- writing `= tyvar` or `= (tyvar :: kind)`. In such case we want to
+          -- be sure that the supplied result name is not identical to an
+          -- already in-scope type variable from an enclosing class.
+          --
+          --  Example of disallowed declaration:
+          --         class C a b where
+          --            type F b = a | a -> b
+          rdr_env <- getLocalRdrEnv
+       ;  let resName = hsLTyVarName tvbndr
+       ;  when (resName `elemLocalRdrEnv` rdr_env) $
+          addErrAt (getLoc tvbndr) $
+                     (hsep [ text "Type variable", quotes (ppr resName) <> comma
+                           , text "naming a type family result,"
+                           ] $$
+                      text "shadows an already bound type variable")
+
+       ; bindLHsTyVarBndr doc Nothing -- this might be a lie, but it's used for
+                                      -- scoping checks that are irrelevant here
+                          (mkNameSet kv_names) emptyNameSet
+                                       -- use of emptyNameSet here avoids
+                                       -- redundant duplicate errors
+                          tvbndr $ \ _ tvbndr' ->
+         return (TyVarSig tvbndr', unitFV (hsLTyVarName tvbndr')) }
+
+-- Note [Renaming injectivity annotation]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- During renaming of injectivity annotation we have to make several checks to
+-- make sure that it is well-formed.  At the moment injectivity annotation
+-- consists of a single injectivity condition, so the terms "injectivity
+-- annotation" and "injectivity condition" might be used interchangeably.  See
+-- Note [Injectivity annotation] for a detailed discussion of currently allowed
+-- injectivity annotations.
+--
+-- Checking LHS is simple because the only type variable allowed on the LHS of
+-- injectivity condition is the variable naming the result in type family head.
+-- Example of disallowed annotation:
+--
+--     type family Foo a b = r | b -> a
+--
+-- Verifying RHS of injectivity consists of checking that:
+--
+--  1. only variables defined in type family head appear on the RHS (kind
+--     variables are also allowed).  Example of disallowed annotation:
+--
+--        type family Foo a = r | r -> b
+--
+--  2. for associated types the result variable does not shadow any of type
+--     class variables. Example of disallowed annotation:
+--
+--        class Foo a b where
+--           type F a = b | b -> a
+--
+-- Breaking any of these assumptions results in an error.
+
+-- | Rename injectivity annotation. Note that injectivity annotation is just the
+-- part after the "|".  Everything that appears before it is renamed in
+-- rnFamDecl.
+rnInjectivityAnn :: LHsQTyVars Name            -- ^ Type variables declared in
+                                               --   type family head
+                 -> LFamilyResultSig Name      -- ^ Result signature
+                 -> LInjectivityAnn RdrName    -- ^ Injectivity annotation
+                 -> RnM (LInjectivityAnn Name)
+rnInjectivityAnn tvBndrs (L _ (TyVarSig resTv))
+                 (L srcSpan (InjectivityAnn injFrom injTo))
+ = do
+   { (injDecl'@(L _ (InjectivityAnn injFrom' injTo')), noRnErrors)
+          <- askNoErrs $
+             bindLocalNames [hsLTyVarName resTv] $
+             -- The return type variable scopes over the injectivity annotation
+             -- e.g.   type family F a = (r::*) | r -> a
+             do { injFrom' <- rnLTyVar injFrom
+                ; injTo'   <- mapM rnLTyVar injTo
+                ; return $ L srcSpan (InjectivityAnn injFrom' injTo') }
+
+   ; let tvNames  = Set.fromList $ hsAllLTyVarNames tvBndrs
+         resName  = hsLTyVarName resTv
+         -- See Note [Renaming injectivity annotation]
+         lhsValid = EQ == (stableNameCmp resName (unLoc injFrom'))
+         rhsValid = Set.fromList (map unLoc injTo') `Set.difference` tvNames
+
+   -- if renaming of type variables ended with errors (eg. there were
+   -- not-in-scope variables) don't check the validity of injectivity
+   -- annotation. This gives better error messages.
+   ; when (noRnErrors && not lhsValid) $
+        addErrAt (getLoc injFrom)
+              ( vcat [ text $ "Incorrect type variable on the LHS of "
+                           ++ "injectivity condition"
+              , nest 5
+              ( vcat [ text "Expected :" <+> ppr resName
+                     , text "Actual   :" <+> ppr injFrom ])])
+
+   ; when (noRnErrors && not (Set.null rhsValid)) $
+      do { let errorVars = Set.toList rhsValid
+         ; addErrAt srcSpan $ ( hsep
+                        [ text "Unknown type variable" <> plural errorVars
+                        , text "on the RHS of injectivity condition:"
+                        , interpp'SP errorVars ] ) }
+
+   ; return injDecl' }
+
+-- We can only hit this case when the user writes injectivity annotation without
+-- naming the result:
+--
+--   type family F a | result -> a
+--   type family F a :: * | result -> a
+--
+-- So we rename injectivity annotation like we normally would except that
+-- this time we expect "result" to be reported not in scope by rnLTyVar.
+rnInjectivityAnn _ _ (L srcSpan (InjectivityAnn injFrom injTo)) =
+   setSrcSpan srcSpan $ do
+   (injDecl', _) <- askNoErrs $ do
+     injFrom' <- rnLTyVar injFrom
+     injTo'   <- mapM rnLTyVar injTo
+     return $ L srcSpan (InjectivityAnn injFrom' injTo')
+   return $ injDecl'
+
 {-
 Note [Stupid theta]
 ~~~~~~~~~~~~~~~~~~~
@@ -1220,7 +1636,7 @@ depAnalTyClDecls ds_w_fvs
         DataDecl { tcdLName = L _ data_name
                  , tcdDataDefn = HsDataDefn { dd_cons = cons } }
           -> do L _ dc <- cons
-                return $ zip (map unLoc $ con_names dc) (repeat data_name)
+                return $ zip (map unLoc $ getConNames dc) (repeat data_name)
         _ -> []
 
 {-
@@ -1277,155 +1693,135 @@ modules), we get better error messages, too.
 ---------------
 badAssocRhs :: [Name] -> RnM ()
 badAssocRhs ns
-  = addErr (hang (ptext (sLit "The RHS of an associated type declaration mentions")
+  = addErr (hang (text "The RHS of an associated type declaration mentions"
                   <+> pprWithCommas (quotes . ppr) ns)
-               2 (ptext (sLit "All such variables must be bound on the LHS")))
+               2 (text "All such variables must be bound on the LHS"))
 
 -----------------
 rnConDecls :: [LConDecl RdrName] -> RnM ([LConDecl Name], FreeVars)
 rnConDecls = mapFvRn (wrapLocFstM rnConDecl)
 
 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name, FreeVars)
-rnConDecl decl@(ConDecl { con_names = names, con_qvars = tvs
-                        , con_cxt = lcxt@(L loc cxt), con_details = details
-                        , con_res = res_ty, con_doc = mb_doc
-                        , con_old_rec = old_rec, con_explicit = expl })
-  = do  { mapM_ (addLocM checkConName) names
-        ; when old_rec (addWarn (deprecRecSyntax decl))
-        ; new_names <- mapM lookupLocatedTopBndrRn names
-
-           -- For H98 syntax, the tvs are the existential ones
-           -- For GADT syntax, the tvs are all the quantified tyvars
-           -- Hence the 'filter' in the ResTyH98 case only
-        ; rdr_env <- getLocalRdrEnv
-        ; let arg_tys    = hsConDeclArgTys details
-              (free_kvs, free_tvs) = case res_ty of
-                                     ResTyH98 -> filterInScope rdr_env (get_rdr_tvs arg_tys)
-                                     ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
-
-         -- With an Explicit forall, check for unused binders
-         -- With Implicit, find the mentioned ones, and use them as binders
-         -- With Qualified, do the same as with Implicit, but give a warning
-         --   See Note [Context quantification]
-        ; new_tvs <- case expl of
-                       Implicit -> return (mkHsQTvs (userHsTyVarBndrs loc free_tvs))
-                       Qualified -> do { warnContextQuantification (docOfHsDocContext doc)
-                                                                   (userHsTyVarBndrs loc free_tvs)
-                                       ; return (mkHsQTvs (userHsTyVarBndrs loc free_tvs)) }
-                       Explicit -> do { warnUnusedForAlls (docOfHsDocContext doc) tvs free_tvs
-                                      ; return tvs }
-
-        ; mb_doc' <- rnMbLHsDoc mb_doc
-
-        ; bindHsTyVars doc Nothing free_kvs new_tvs $ \new_tyvars -> do
-        { (new_context, fvs1) <- rnContext doc lcxt
-        ; (new_details, fvs2) <- rnConDeclDetails doc details
-        ; (new_details', new_res_ty, fvs3)
-                     <- rnConResult doc (map unLoc new_names) new_details res_ty
-        ; return (decl { con_names = new_names, con_qvars = new_tyvars
+rnConDecl decl@(ConDeclH98 { con_name = name, con_qvars = qtvs
+                           , con_cxt = mcxt, con_details = details
+                           , con_doc = mb_doc })
+  = do  { _ <- addLocM checkConName name
+        ; new_name     <- lookupLocatedTopBndrRn name
+        ; let doc = ConDeclCtx [new_name]
+        ; mb_doc'      <- rnMbLHsDoc mb_doc
+        ; (kvs, qtvs') <- get_con_qtvs (hsConDeclArgTys details)
+
+        ; bindHsQTyVars doc (Just $ inHsDocContext doc) Nothing kvs qtvs' $
+          \new_tyvars -> do
+        { (new_context, fvs1) <- case mcxt of
+                             Nothing   -> return (Nothing,emptyFVs)
+                             Just lcxt -> do { (lctx',fvs) <- rnContext doc lcxt
+                                             ; return (Just lctx',fvs) }
+        ; (new_details, fvs2) <- rnConDeclDetails (unLoc new_name) doc details
+        ; let (new_details',fvs3) = (new_details,emptyFVs)
+        ; traceRn (text "rnConDecl" <+> ppr name <+> vcat
+             [ text "free_kvs:" <+> ppr kvs
+             , text "qtvs:" <+> ppr qtvs
+             , text "qtvs':" <+> ppr qtvs' ])
+        ; let all_fvs = fvs1 `plusFV` fvs2 `plusFV` fvs3
+              new_tyvars' = case qtvs of
+                Nothing -> Nothing
+                Just _ -> Just new_tyvars
+        ; return (decl { con_name = new_name, con_qvars = new_tyvars'
                        , con_cxt = new_context, con_details = new_details'
-                       , con_res = new_res_ty, con_doc = mb_doc' },
-                  fvs1 `plusFV` fvs2 `plusFV` fvs3) }}
+                       , con_doc = mb_doc' },
+                  all_fvs) }}
  where
-    doc = ConDeclCtx names
+    cxt = maybe [] unLoc mcxt
     get_rdr_tvs tys = extractHsTysRdrTyVars (cxt ++ tys)
 
-rnConResult :: HsDocContext -> [Name]
-            -> HsConDetails (LHsType Name) [LConDeclField Name]
-            -> ResType (LHsType RdrName)
-            -> RnM (HsConDetails (LHsType Name) [LConDeclField Name],
-                    ResType (LHsType Name), FreeVars)
-rnConResult _   _   details ResTyH98 = return (details, ResTyH98, emptyFVs)
-rnConResult doc _con details (ResTyGADT ty)
-  = do { (ty', fvs) <- rnLHsType doc ty
-       ; let (arg_tys, res_ty) = splitHsFunType ty'
-                -- We can finally split it up,
-                -- now the renamer has dealt with fixities
-                -- See Note [Sorting out the result type] in RdrHsSyn
-
-       ; case details of
-           InfixCon {}  -> pprPanic "rnConResult" (ppr ty)
-           -- See Note [Sorting out the result type] in RdrHsSyn
-
-           RecCon {}    -> do { unless (null arg_tys)
-                                       (addErr (badRecResTy (docOfHsDocContext doc)))
-                              ; return (details, ResTyGADT res_ty, fvs) }
-
-           PrefixCon {} -> return (PrefixCon arg_tys, ResTyGADT res_ty, fvs) }
+    get_con_qtvs :: [LHsType RdrName]
+                 -> RnM ([Located RdrName], LHsQTyVars RdrName)
+    get_con_qtvs arg_tys
+      | Just tvs <- qtvs   -- data T = forall a. MkT (a -> a)
+      = do { free_vars <- get_rdr_tvs arg_tys
+           ; return (freeKiTyVarsKindVars free_vars, tvs) }
+      | otherwise  -- data T = MkT (a -> a)
+      = return ([], mkHsQTvs [])
+
+rnConDecl decl@(ConDeclGADT { con_names = names, con_type = ty
+                            , con_doc = mb_doc })
+  = do  { mapM_ (addLocM checkConName) names
+        ; new_names    <- mapM lookupLocatedTopBndrRn names
+        ; let doc = ConDeclCtx new_names
+        ; mb_doc'      <- rnMbLHsDoc mb_doc
+
+        ; (ty', fvs) <- rnHsSigType doc ty
+        ; traceRn (text "rnConDecl" <+> ppr names <+> vcat
+             [ text "fvs:" <+> ppr fvs ])
+        ; return (decl { con_names = new_names, con_type = ty'
+                       , con_doc = mb_doc' },
+                  fvs) }
 
 rnConDeclDetails
-    :: HsDocContext
-    -> HsConDetails (LHsType RdrName) [LConDeclField RdrName]
-    -> RnM (HsConDetails (LHsType Name) [LConDeclField Name], FreeVars)
-rnConDeclDetails doc (PrefixCon tys)
+   :: Name
+   -> HsDocContext
+   -> HsConDetails (LHsType RdrName) (Located [LConDeclField RdrName])
+   -> RnM (HsConDetails (LHsType Name) (Located [LConDeclField Name]), FreeVars)
+rnConDeclDetails _ doc (PrefixCon tys)
   = do { (new_tys, fvs) <- rnLHsTypes doc tys
        ; return (PrefixCon new_tys, fvs) }
 
-rnConDeclDetails doc (InfixCon ty1 ty2)
+rnConDeclDetails doc (InfixCon ty1 ty2)
   = do { (new_ty1, fvs1) <- rnLHsType doc ty1
        ; (new_ty2, fvs2) <- rnLHsType doc ty2
        ; return (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2) }
 
-rnConDeclDetails doc (RecCon fields)
-  = do  { (new_fields, fvs) <- rnConDeclFields doc fields
+rnConDeclDetails con doc (RecCon (L l fields))
+  = do  { fls <- lookupConstructorFields con
+        ; (new_fields, fvs) <- rnConDeclFields doc fls fields
                 -- No need to check for duplicate fields
                 -- since that is done by RnNames.extendGlobalRdrEnvRn
-        ; return (RecCon new_fields, fvs) }
+        ; return (RecCon (L l new_fields), fvs) }
 
 -------------------------------------------------
-deprecRecSyntax :: ConDecl RdrName -> SDoc
-deprecRecSyntax decl
-  = vcat [ ptext (sLit "Declaration of") <+> quotes (ppr (con_names decl))
-                 <+> ptext (sLit "uses deprecated syntax")
-         , ptext (sLit "Instead, use the form")
-         , nest 2 (ppr decl) ]   -- Pretty printer uses new form
-
-badRecResTy :: SDoc -> SDoc
-badRecResTy doc = ptext (sLit "Malformed constructor signature") $$ doc
 
-{-
-*********************************************************
-*                                                      *
-\subsection{Support code for type/data declarations}
-*                                                      *
-*********************************************************
-
-Get the mapping from constructors to fields for this module.
-It's convenient to do this after the data type decls have been renamed
--}
-
-extendRecordFieldEnv :: [TyClGroup RdrName] -> [LInstDecl RdrName] -> TcM TcGblEnv
-extendRecordFieldEnv tycl_decls inst_decls
-  = do  { tcg_env <- getGblEnv
-        ; field_env' <- foldrM get_con (tcg_field_env tcg_env) all_data_cons
-        ; return (tcg_env { tcg_field_env = field_env' }) }
+-- | Brings pattern synonym names and also pattern synonym selectors
+-- from record pattern synonyms into scope.
+extendPatSynEnv :: HsValBinds RdrName -> MiniFixityEnv
+                -> ([Name] -> TcRnIf TcGblEnv TcLclEnv a) -> TcM a
+extendPatSynEnv val_decls local_fix_env thing = do {
+     names_with_fls <- new_ps val_decls
+   ; let pat_syn_bndrs =
+          concat [name: map flSelector fields | (name, fields) <- names_with_fls]
+   ; let avails = map patSynAvail pat_syn_bndrs
+   ; (gbl_env, lcl_env) <-
+        extendGlobalRdrEnvRn avails local_fix_env
+
+
+   ; let field_env' = extendNameEnvList (tcg_field_env gbl_env) names_with_fls
+         final_gbl_env = gbl_env { tcg_field_env = field_env' }
+   ; setEnvs (final_gbl_env, lcl_env) (thing pat_syn_bndrs) }
   where
-    -- we want to lookup:
-    --  (a) a datatype constructor
-    --  (b) a record field
-    -- knowing that they're from this module.
-    -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn_maybe,
-    -- which keeps only the local ones.
-    lookup x = do { x' <- lookupLocatedTopBndrRn x
-                    ; return $ unLoc x'}
-
-    all_data_cons :: [ConDecl RdrName]
-    all_data_cons = [con | HsDataDefn { dd_cons = cons } <- all_ty_defs
-                         , L _ con <- cons ]
-    all_ty_defs = [ defn | L _ (DataDecl { tcdDataDefn = defn })
-                                                 <- tyClGroupConcat tycl_decls ]
-               ++ map dfid_defn (instDeclDataFamInsts inst_decls)
-                                              -- Do not forget associated types!
-
-    get_con (ConDecl { con_names = cons, con_details = RecCon flds })
-            (RecFields env fld_set)
-        = do { cons' <- mapM lookup cons
-             ; flds' <- mapM lookup (concatMap (cd_fld_names . unLoc) flds)
-             ; let env'    = foldl (\e c -> extendNameEnv e c flds') env cons'
-
-                   fld_set' = extendNameSetList fld_set flds'
-             ; return $ (RecFields env' fld_set') }
-    get_con _ env = return env
+    new_ps :: HsValBinds RdrName -> TcM [(Name, [FieldLabel])]
+    new_ps (ValBindsIn binds _) = foldrBagM new_ps' [] binds
+    new_ps _ = panic "new_ps"
+
+    new_ps' :: LHsBindLR RdrName RdrName
+            -> [(Name, [FieldLabel])]
+            -> TcM [(Name, [FieldLabel])]
+    new_ps' bind names
+      | L bind_loc (PatSynBind (PSB { psb_id = L _ n
+                                    , psb_args = RecordPatSyn as })) <- bind
+      = do
+          bnd_name <- newTopSrcBinder (L bind_loc n)
+          let rnames = map recordPatSynSelectorId as
+              mkFieldOcc :: Located RdrName -> LFieldOcc RdrName
+              mkFieldOcc (L l name) = L l (FieldOcc (L l name) PlaceHolder)
+              field_occs =  map mkFieldOcc rnames
+          flds     <- mapM (newRecordSelector False [bnd_name]) field_occs
+          return ((bnd_name, flds): names)
+      | L bind_loc (PatSynBind (PSB { psb_id = L _ n})) <- bind
+      = do
+        bnd_name <- newTopSrcBinder (L bind_loc n)
+        return ((bnd_name, []): names)
+      | otherwise
+      = return names
 
 {-
 *********************************************************
@@ -1435,7 +1831,8 @@ extendRecordFieldEnv tycl_decls inst_decls
 *********************************************************
 -}
 
-rnFds :: [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
+rnFds :: [Located (FunDep (Located RdrName))]
+  -> RnM [Located (FunDep (Located Name))]
 rnFds fds
   = mapM (wrapLocM rn_fds) fds
   where
@@ -1444,11 +1841,13 @@ rnFds fds
            ; tys2' <- rnHsTyVars tys2
            ; return (tys1', tys2') }
 
-rnHsTyVars :: [RdrName] -> RnM [Name]
+rnHsTyVars :: [Located RdrName] -> RnM [Located Name]
 rnHsTyVars tvs  = mapM rnHsTyVar tvs
 
-rnHsTyVar :: RdrName -> RnM Name
-rnHsTyVar tyvar = lookupOccRn tyvar
+rnHsTyVar :: Located RdrName -> RnM (Located Name)
+rnHsTyVar (L l tyvar) = do
+  tyvar' <- lookupOccRn tyvar
+  return (L l tyvar')
 
 {-
 *********************************************************
@@ -1476,23 +1875,26 @@ addl gp (L l d : ds) = add gp l d ds
 add :: HsGroup RdrName -> SrcSpan -> HsDecl RdrName -> [LHsDecl RdrName]
     -> RnM (HsGroup RdrName, Maybe (SpliceDecl RdrName, [LHsDecl RdrName]))
 
+-- #10047: Declaration QuasiQuoters are expanded immediately, without
+--         causing a group split
+add gp _ (SpliceD (SpliceDecl (L _ qq@HsQuasiQuote{}) _)) ds
+  = do { (ds', _) <- rnTopSpliceDecls qq
+       ; addl gp (ds' ++ ds)
+       }
+
 add gp loc (SpliceD splice@(SpliceDecl _ flag)) ds
   = do { -- We've found a top-level splice.  If it is an *implicit* one
          -- (i.e. a naked top level expression)
          case flag of
            ExplicitSplice -> return ()
-           ImplicitSplice -> do { th_on <- xoptM Opt_TemplateHaskell
+           ImplicitSplice -> do { th_on <- xoptM LangExt.TemplateHaskell
                                 ; unless th_on $ setSrcSpan loc $
                                   failWith badImplicitSplice }
 
        ; return (gp, Just (splice, ds)) }
   where
-    badImplicitSplice = ptext (sLit "Parse error: naked expression at top level")
-                     $$ ptext (sLit "Perhaps you intended to use TemplateHaskell")
-
-add gp _ (QuasiQuoteD qq) ds            -- Expand quasiquotes
-  = do { ds' <- runQuasiQuoteDecl qq
-       ; addl gp (ds' ++ ds) }
+    badImplicitSplice = text "Parse error: naked expression at top level"
+                     $$ text "Perhaps you intended to use TemplateHaskell"
 
 -- Class declarations: pull out the fixity signatures to the top
 add gp@(HsGroup {hs_tyclds = ts, hs_fixds = fs}) l (TyClD d) ds