Refactor visible type application.
[ghc.git] / compiler / rename / RnSource.hs
index 90bf09a..df729dc 100644 (file)
@@ -30,7 +30,12 @@ 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
@@ -42,16 +47,14 @@ 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 qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
 import Data.List ( sortBy )
 import Maybes( orElse, mapMaybe )
 import qualified Data.Set as Set ( difference, fromList, toList, null )
-#if __GLASGOW_HASKELL__ < 709
-import Data.Traversable (traverse)
-#endif
 
 {-
 @rnSourceDecl@ `renames' declarations.
@@ -127,7 +130,7 @@ rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
    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 ;
+   tc_envs <- extendGlobalRdrEnvRn (map avail id_bndrs) local_fix_env ;
    traceRn (text "D2" <+> ppr (tcg_rdr_env (fst tc_envs)));
    setEnvs tc_envs $ do {
 
@@ -149,7 +152,13 @@ rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
    -- (F) Rename Value declarations right-hand sides
    traceRn (text "Start rnmono") ;
    let { val_bndr_set = mkNameSet id_bndrs `unionNameSet` mkNameSet pat_syn_bndrs } ;
-   (rn_val_decls, bind_dus) <- rnTopBindsRHS val_bndr_set new_lhs ;
+   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
@@ -167,7 +176,7 @@ rnSrcDecls 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 $
+   (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 ;
@@ -283,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"
 
 {-
 *********************************************************
@@ -321,9 +330,9 @@ rnSrcWarnDecls bndr_set decls'
        -- ensures that the names are defined locally
      = do { names <- concatMapM (lookupLocalTcNames sig_ctxt what . unLoc)
                                 rdr_names
-          ; return [(nameOccName name, txt) | name <- names] }
+          ; return [(rdrNameOcc rdr, txt) | (rdr, _) <- names] }
 
-   what = ptext (sLit "deprecation")
+   what = text "deprecation"
 
    warn_rdr_dups = findDupRdrNames $ concatMap (\(L _ (Warning ns _)) -> ns)
                                                decls
@@ -338,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]
 
 {-
 *********************************************************
@@ -387,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 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
@@ -449,37 +463,230 @@ 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 ktv_names = hsLKiTyVarNames inst_tyvars
-
-        -- 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
+  = 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)
+       ; 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
+                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
@@ -488,7 +695,7 @@ 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' },
-                 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.
@@ -503,58 +710,70 @@ 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'
-             awcs = concatMap collectAnonymousWildCardNames pats'
        ; return (tycon',
-                 HsWB { hswb_cts = pats', hswb_kvs = kv_names,
-                        hswb_tvs = tv_names, hswb_wcs = awcs },
+                 HsIB { hsib_body = pats'
+                      , hsib_vars = all_ibs },
                  payload',
                  all_fvs) }
              -- type instance => use, hence addOneFV
-  where
-    collectAnonymousWildCardNames ty
-      = [ wildCardName wc
-        | L _ wc <- snd (collectWildCards ty)
-        , isAnonWildCard wc ]
-
 
 rnTyFamInstDecl :: Maybe (Name, [Name])
                 -> TyFamInstDecl RdrName
@@ -568,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
@@ -582,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'
@@ -595,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
@@ -617,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
@@ -625,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
@@ -671,15 +927,15 @@ Here 'k' is in scope in the kind signature, just like 'x'.
 
 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")
 
 {-
 *********************************************************
@@ -724,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 +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
@@ -791,21 +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") <+> pprRuleName name <> colon,
+  = sep [text "Rule" <+> pprRuleName name <> colon,
          nest 4 (vcat [err,
-                       ptext (sLit "in left-hand side:") <+> ppr lhs])]
+                       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 -> ptext (sLit "Not in scope:") <+> ppr occ
-            _ -> ptext (sLit "Illegal expression:") <+> ppr bad_e
+            HsUnboundVar occ -> text "Not in scope:" <+> ppr occ
+            _ -> text "Illegal expression:" <+> ppr bad_e
 
 {-
 *********************************************************
@@ -825,8 +1082,8 @@ rnHsVectDecl (HsVect s var rhs@(L _ (HsVar _)))
        }
 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 s var)
   = do { var' <- lookupLocatedTopBndrRn var           -- only applies to local (not imported) names
@@ -851,7 +1108,7 @@ rnHsVectDecl (HsVectClassIn s 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 _)
@@ -925,7 +1182,7 @@ See also Note [Grouping of type and class declarations] in TcTyClsDecls.
 
 rnTyClDecls :: [TyClGroup RdrName]
             -> RnM ([TyClGroup Name], FreeVars)
--- Rename the declarations and do depedency analysis on them
+-- 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)
@@ -990,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) }
@@ -1004,20 +1261,19 @@ 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
@@ -1025,7 +1281,7 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = lcls,
 
         -- Tyvars scope over superclass context and method signatures
         ; ((tyvars', context', fds', ats'), stuff_fvs)
-            <- bindHsTyVars cls_doc Nothing kvs tyvars $ \ tyvars' -> do
+            <- bindHsQTyVars cls_doc Nothing Nothing kvs tyvars $ \ tyvars' -> do
                   -- Checks for distinct tyvars
              { (context', cxt_fvs) <- rnContext cls_doc context
              ; fds'  <- rnFds fds
@@ -1042,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.
@@ -1058,7 +1315,7 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = lcls,
         -- we want to name both "x" tyvars with the same unique, so that they are
         -- easy to group together in the typechecker.
         ; (mbinds', sigs', meth_fvs)
-            <- rnMethodBinds True cls' (hsLKiTyVarNames tyvars') mbinds sigs
+            <- 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
@@ -1165,17 +1422,19 @@ 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
@@ -1186,12 +1445,15 @@ rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars
                              , fdInfo = info, fdResultSig = res_sig
                              , fdInjectivityAnn = injectivity })
   = do { tycon' <- lookupLocatedTopBndrRn tycon
+       ; kvs <- extractRdrKindSigVars res_sig
        ; ((tyvars', res_sig', injectivity'), fv1) <-
-            bindHsTyVars doc mb_cls kvs tyvars $ \ tyvars' ->
-            do { (res_sig', fv_kind) <- wrapLocFstM (rnFamResultSig doc) res_sig
+            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 )  }
+               ; return ( (tyvars', res_sig', injectivity') , fv_kind ) }
        ; (info', fv2) <- rn_info info
        ; return (FamilyDecl { fdLName = tycon', fdTyVars = tyvars'
                             , fdInfo = info', fdResultSig = res_sig'
@@ -1199,7 +1461,6 @@ rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars
                 , fv1 `plusFV` fv2) }
   where
      doc = TyFamilyCtx tycon
-     kvs = extractRdrKindSigVars res_sig
 
      ----------------------
      rn_info (ClosedTypeFamily (Just eqns))
@@ -1211,29 +1472,24 @@ rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars
      rn_info OpenTypeFamily = return (OpenTypeFamily, emptyFVs)
      rn_info DataFamily     = return (DataFamily, emptyFVs)
 
-rnFamResultSig :: HsDocContext -> FamilyResultSig RdrName
+rnFamResultSig :: HsDocContext
+               -> [Name]   -- kind variables already in scope
+               -> FamilyResultSig RdrName
                -> RnM (FamilyResultSig Name, FreeVars)
-rnFamResultSig _ NoSig
+rnFamResultSig _ NoSig
    = return (NoSig, emptyFVs)
-rnFamResultSig doc (KindSig kind)
+rnFamResultSig doc (KindSig kind)
    = do { (rndKind, ftvs) <- rnLHsKind doc kind
         ;  return (KindSig rndKind, ftvs) }
-rnFamResultSig doc (TyVarSig tvbndr)
+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 variables:
+          -- already in-scope type variable from an enclosing class.
           --
-          --  (a) one of already declared type family arguments. Example of
-          --      disallowed declaration:
-          --        type family F a = a
-          --
-          --  (b) already in-scope type variable. This second case might happen
-          --      for associated types, where type class head bounds some type
-          --      variables. Example of disallowed declaration:
+          --  Example of disallowed declaration:
           --         class C a b where
           --            type F b = a | a -> b
-          -- Both are caught by the "in-scope" check that comes next
           rdr_env <- getLocalRdrEnv
        ;  let resName = hsLTyVarName tvbndr
        ;  when (resName `elemLocalRdrEnv` rdr_env) $
@@ -1243,8 +1499,13 @@ rnFamResultSig doc (TyVarSig tvbndr)
                            ] $$
                       text "shadows an already bound type variable")
 
-       ; (tvbndr', fvs) <- rnLHsTyVarBndr doc Nothing rdr_env tvbndr
-       ; return (TyVarSig tvbndr', fvs) }
+       ; 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]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1280,7 +1541,7 @@ rnFamResultSig doc (TyVarSig tvbndr)
 -- | Rename injectivity annotation. Note that injectivity annotation is just the
 -- part after the "|".  Everything that appears before it is renamed in
 -- rnFamDecl.
-rnInjectivityAnn :: LHsTyVarBndrs Name         -- ^ Type variables declared in
+rnInjectivityAnn :: LHsQTyVars Name            -- ^ Type variables declared in
                                                --   type family head
                  -> LFamilyResultSig Name      -- ^ Result signature
                  -> LInjectivityAnn RdrName    -- ^ Injectivity annotation
@@ -1293,11 +1554,11 @@ rnInjectivityAnn tvBndrs (L _ (TyVarSig resTv))
              bindLocalNames [hsLTyVarName resTv] $
              -- The return type variable scopes over the injectivity annotation
              -- e.g.   type family F a = (r::*) | r -> a
-             do { injFrom' <- rnLTyVar True injFrom
-                ; injTo'   <- mapM (rnLTyVar True) injTo
+             do { injFrom' <- rnLTyVar injFrom
+                ; injTo'   <- mapM rnLTyVar injTo
                 ; return $ L srcSpan (InjectivityAnn injFrom' injTo') }
 
-   ; let tvNames  = Set.fromList $ hsLKiTyVarNames tvBndrs
+   ; let tvNames  = Set.fromList $ hsAllLTyVarNames tvBndrs
          resName  = hsLTyVarName resTv
          -- See Note [Renaming injectivity annotation]
          lhsValid = EQ == (stableNameCmp resName (unLoc injFrom'))
@@ -1334,8 +1595,8 @@ rnInjectivityAnn tvBndrs (L _ (TyVarSig resTv))
 rnInjectivityAnn _ _ (L srcSpan (InjectivityAnn injFrom injTo)) =
    setSrcSpan srcSpan $ do
    (injDecl', _) <- askNoErrs $ do
-     injFrom' <- rnLTyVar True injFrom
-     injTo'   <- mapM (rnLTyVar True) injTo
+     injFrom' <- rnLTyVar injFrom
+     injTo'   <- mapM rnLTyVar injTo
      return $ L srcSpan (InjectivityAnn injFrom' injTo')
    return $ injDecl'
 
@@ -1375,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)
         _ -> []
 
 {-
@@ -1432,81 +1693,70 @@ 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 (unLoc $ head new_names) 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) (Located [LConDeclField Name])
-            -> ResType (LHsType RdrName)
-            -> RnM (HsConDetails (LHsType Name) (Located [LConDeclField Name]),
-                    ResType (LHsType Name), FreeVars)
-rnConResult _   _   details ResTyH98 = return (details, ResTyH98, emptyFVs)
-rnConResult doc _con details (ResTyGADT ls 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 ls res_ty, fvs) }
-
-           PrefixCon {} -> return (PrefixCon arg_tys, ResTyGADT ls 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
    :: Name
@@ -1524,21 +1774,12 @@ rnConDeclDetails _ doc (InfixCon ty1 ty2)
 
 rnConDeclDetails con doc (RecCon (L l fields))
   = do  { fls <- lookupConstructorFields con
-        ; (new_fields, fvs) <- rnConDeclFields fls doc fields
+        ; (new_fields, fvs) <- rnConDeclFields doc fls fields
                 -- No need to check for duplicate fields
                 -- since that is done by RnNames.extendGlobalRdrEnvRn
         ; 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
 
 -- | Brings pattern synonym names and also pattern synonym selectors
 -- from record pattern synonyms into scope.
@@ -1548,7 +1789,7 @@ 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 Avail pat_syn_bndrs
+   ; let avails = map patSynAvail pat_syn_bndrs
    ; (gbl_env, lcl_env) <-
         extendGlobalRdrEnvRn avails local_fix_env
 
@@ -1571,7 +1812,7 @@ extendPatSynEnv val_decls local_fix_env thing = 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 name PlaceHolder)
+              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)
@@ -1646,14 +1887,14 @@ add gp loc (SpliceD splice@(SpliceDecl _ flag)) ds
          -- (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")
+    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