Refactor named wildcards (again)
authorSimon Peyton Jones <simonpj@microsoft.com>
Tue, 22 Dec 2015 16:28:50 +0000 (16:28 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Tue, 22 Dec 2015 16:35:39 +0000 (16:35 +0000)
Michal's work on #10982, #11098, refactored the handling of named
wildcards by making them more like ordinary type variables.

This patch takes the same idea to its logical conclusion, resulting
in a much tidier, tighter implementation.

Read Note [The wildcard story for types] in HsTypes.

Changes:

 * Named wildcards are ordinary type variables, throughout

 * HsType no longer has a data constructor for named wildcards
   (was NamedWildCard in HsWildCardInfo).  Named wildcards are
   simply HsTyVars

 * Similarly named wildcards disappear from Template Haskell

 * I refactored RnTypes to avoid polluting LocalRdrEnv with something
   as narrow as named wildcards.  Instead the named wildcard set is
   carried in RnTyKiEnv.

There is a submodule update for Haddock.

16 files changed:
compiler/basicTypes/RdrName.hs
compiler/deSugar/DsMeta.hs
compiler/hsSyn/Convert.hs
compiler/hsSyn/HsTypes.hs
compiler/prelude/THNames.hs
compiler/rename/RnSource.hs
compiler/rename/RnTypes.hs
libraries/template-haskell/Language/Haskell/TH/Lib.hs
libraries/template-haskell/Language/Haskell/TH/Ppr.hs
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
testsuite/tests/ghci/scripts/T11098.stdout
testsuite/tests/partial-sigs/should_compile/Splices.hs
testsuite/tests/partial-sigs/should_compile/SplicesUsed.hs
testsuite/tests/partial-sigs/should_fail/NamedExtraConstraintsWildcard.hs
testsuite/tests/partial-sigs/should_fail/NamedExtraConstraintsWildcard.stderr
utils/haddock

index c1ae468..ce69706 100644 (file)
@@ -41,7 +41,6 @@ module RdrName (
         lookupLocalRdrEnv, lookupLocalRdrOcc,
         elemLocalRdrEnv, inLocalRdrEnvScope,
         localRdrEnvElts, delLocalRdrEnvList,
-        extendLocalRdrEnvNwcs, inLocalRdrEnvNwcsRdrName, delLocalRdrEnvNwcs,
 
         -- * Global mapping of 'RdrName' to 'GlobalRdrElt's
         GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
@@ -327,17 +326,14 @@ instance Ord RdrName where
 -- be replaced with named wildcards.
 -- See Note [Renaming named wild cards] in RnTypes
 data LocalRdrEnv = LRE { lre_env      :: OccEnv Name
-                       , lre_in_scope :: NameSet
-                       , lre_nwcs     :: NameSet }
+                       , lre_in_scope :: NameSet }
 
 instance Outputable LocalRdrEnv where
-  ppr (LRE {lre_env = env, lre_in_scope = ns, lre_nwcs = nwcs})
+  ppr (LRE {lre_env = env, lre_in_scope = ns})
     = hang (ptext (sLit "LocalRdrEnv {"))
          2 (vcat [ ptext (sLit "env =") <+> pprOccEnv ppr_elt env
                  , ptext (sLit "in_scope =")
                     <+> braces (pprWithCommas ppr (nameSetElems ns))
-                 , ptext (sLit "nwcs =")
-                    <+> braces (pprWithCommas ppr (nameSetElems nwcs))
                  ] <+> char '}')
     where
       ppr_elt name = parens (ppr (getUnique (nameOccName name))) <+> ppr name
@@ -345,8 +341,7 @@ instance Outputable LocalRdrEnv where
 
 emptyLocalRdrEnv :: LocalRdrEnv
 emptyLocalRdrEnv = LRE { lre_env = emptyOccEnv
-                       , lre_in_scope = emptyNameSet
-                       , lre_nwcs = emptyNameSet }
+                       , lre_in_scope = emptyNameSet }
 
 extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv
 -- The Name should be a non-top-level thing
@@ -387,27 +382,6 @@ delLocalRdrEnvList :: LocalRdrEnv -> [OccName] -> LocalRdrEnv
 delLocalRdrEnvList lre@(LRE { lre_env = env }) occs
   = lre { lre_env = delListFromOccEnv env occs }
 
-extendLocalRdrEnvNwcs:: LocalRdrEnv -> [Name] -> LocalRdrEnv
-extendLocalRdrEnvNwcs lre@(LRE { lre_nwcs = nwcs }) names
-  = lre { lre_nwcs = extendNameSetList nwcs names }
-
-inLocalRdrEnvNwcs :: Name -> LocalRdrEnv -> Bool
-inLocalRdrEnvNwcs name (LRE { lre_nwcs = nwcs }) = name `elemNameSet` nwcs
-
-inLocalRdrEnvNwcsRdrName :: RdrName -> LocalRdrEnv -> Bool
-inLocalRdrEnvNwcsRdrName rdr_name lcl_env@(LRE { lre_nwcs = nwcs })
-  | isEmptyNameSet nwcs = False
-  | otherwise = case rdr_name of
-      Unqual occ -> case lookupLocalRdrOcc lcl_env occ of
-          Just name -> inLocalRdrEnvNwcs name lcl_env
-          Nothing   -> False
-      Exact name -> inLocalRdrEnvNwcs name lcl_env
-      _ -> False
-
-delLocalRdrEnvNwcs :: LocalRdrEnv -> [Name] -> LocalRdrEnv
-delLocalRdrEnvNwcs lre@(LRE { lre_nwcs = nwcs }) names
-  = lre { lre_nwcs = delListFromNameSet nwcs names }
-
 {-
 Note [Local bindings with Exact Names]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
index f56f446..5153dd9 100644 (file)
@@ -965,9 +965,6 @@ repTy (HsTyLit lit) = do
                         lit' <- repTyLit lit
                         repTLit lit'
 repTy (HsWildCardTy (AnonWildCard _)) = repTWildCard
-repTy (HsWildCardTy (NamedWildCard (L _ n))) = do
-                                           nwc <- lookupOcc n
-                                           repTNamedWildCard nwc
 
 repTy ty                      = notHandled "Exotic form of type" (ppr ty)
 
@@ -2045,10 +2042,6 @@ repTLit (MkC lit) = rep2 litTName [lit]
 repTWildCard :: DsM (Core TH.TypeQ)
 repTWildCard = rep2 wildCardTName []
 
-repTNamedWildCard :: Core TH.Name -> DsM (Core TH.TypeQ)
-repTNamedWildCard (MkC s) = rep2 namedWildCardTName [s]
-
-
 --------- Type constructors --------------
 
 repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
index 4b79922..6269a8b 100644 (file)
@@ -1142,13 +1142,9 @@ cvtTypeKind ty_str ty
            LitT lit
              -> returnL (HsTyLit (cvtTyLit lit))
 
-           WildCardT Nothing
+           WildCardT
              -> mk_apps mkAnonWildCardTy tys'
 
-           WildCardT (Just nm)
-             -> do { nm' <- tNameL nm
-                   ; mk_apps (mkNamedWildCardTy nm') tys' }
-
            InfixT t1 s t2
              -> do { s'  <- tconName s
                    ; t1' <- cvtType t1
index 00cab90..d414880 100644 (file)
@@ -43,9 +43,8 @@ module HsTypes (
         rdrNameAmbiguousFieldOcc, selectorAmbiguousFieldOcc,
         unambiguousFieldOcc, ambiguousFieldOcc,
 
-        HsWildCardInfo(..), mkAnonWildCardTy, mkNamedWildCardTy,
-        wildCardName, sameWildCard, sameNamedWildCard,
-        isAnonWildCard, isNamedWildCard,
+        HsWildCardInfo(..), mkAnonWildCardTy,
+        wildCardName, sameWildCard,
 
         mkHsImplicitBndrs, mkHsWildCardBndrs, hsImplicitBody,
         mkEmptyImplicitBndrs, mkEmptyWildCardBndrs,
@@ -178,6 +177,44 @@ is a bit complicated.  Here's how it works.
       class C (a :: k -> *) where ...
   The 'k' is implicitly bound in the hsq_tvs field of LHsQTyVars
 
+Note [The wildcard story for types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Types can have wildcards in them, to support partial type signatures,
+like       f :: Int -> (_ , _a) -> _a
+
+A wildcard in a type can be
+
+  * An anonymous wildcard,
+        written '_'
+    In HsType this is represented by HsWildCardTy.
+    After the renamer, this contains a Name which uniquely
+    identifies this particular occurrence.
+
+  * A named wildcard,
+        written '_a', '_foo', etc
+    In HsType this is represented by (HsTyVar "_a")
+    i.e. a perfectly ordinary type variable that happens
+         to start with an underscore
+
+Note carefully:
+
+* When NamedWildCards is off, type variables that start with an
+  underscore really /are/ ordinary type variables.  And indeed, even
+  when NamedWildCards is on you can bind _a explicitly as an ordinary
+  type variable:
+        data T _a _b = MkT _b _a
+  Or even:
+        f :: forall _a. _a -> _b
+  Here _a is an ordinary forall'd binder, but (With NamedWildCards)
+  _b is a named wildcard.  (See the comments in Trac #10982)
+
+* All wildcards, whether named or anonymous, are bound by the
+  HsWildCardBndrs construct, which wraps types that are allowed
+  to have wildcards.
+
+* After type checking is done, we report what types the wildcards
+  got unified with.
+
 -}
 
 type LHsContext name = Located (HsContext name)
@@ -242,7 +279,9 @@ data HsImplicitBndrs name thing   -- See Note [HsType binders]
     }
   deriving (Typeable)
 
-data HsWildCardBndrs name thing   -- See Note [HsType binders]
+data HsWildCardBndrs name thing
+    -- See Note [HsType binders]
+    -- See Note [The wildcard story for types]
   = HsWC { hswc_wcs :: PostRn name [Name]
                 -- Wild cards, both named and anonymous
 
@@ -517,6 +556,7 @@ data HsType name
       -- For details on above see note [Api annotations] in ApiAnnotation
 
   | HsWildCardTy (HsWildCardInfo name)  -- A type wildcard
+      -- See Note [The wildcard story for types]
       -- ^ - 'ApiAnnotation.AnnKeywordId' : None
 
       -- For details on above see note [Api annotations] in ApiAnnotation
@@ -533,12 +573,10 @@ data HsTyLit
 mkHsOpTy :: LHsType name -> Located name -> LHsType name -> HsType name
 mkHsOpTy ty1 op ty2 = HsOpTy ty1 op ty2
 
-data HsWildCardInfo name
+newtype HsWildCardInfo name      -- See Note [The wildcard story for types]
     = AnonWildCard (PostRn name (Located Name))
       -- A anonymous wild card ('_'). A fresh Name is generated for
       -- each individual anonymous wildcard during renaming
-    | NamedWildCard (Located name)
-      -- A named wild card ('_a').
     deriving (Typeable)
 deriving instance (DataId name) => Data (HsWildCardInfo name)
 
@@ -891,36 +929,13 @@ hsLTyVarBndrsToTypes (HsQTvs { hsq_explicit = tvbs }) = map hsLTyVarBndrToType t
 mkAnonWildCardTy :: HsType RdrName
 mkAnonWildCardTy = HsWildCardTy (AnonWildCard PlaceHolder)
 
-mkNamedWildCardTy :: Located n -> HsType n
-mkNamedWildCardTy = HsWildCardTy . NamedWildCard
-
-isAnonWildCard :: HsWildCardInfo name -> Bool
-isAnonWildCard (AnonWildCard _) = True
-isAnonWildCard _                = False
-
-isNamedWildCard :: HsWildCardInfo name -> Bool
-isNamedWildCard = not . isAnonWildCard
-
 wildCardName :: HsWildCardInfo Name -> Name
-wildCardName (NamedWildCard (L _ n)) = n
 wildCardName (AnonWildCard  (L _ n)) = n
 
--- Two wild cards are the same when: they're both named and have the same
--- name, or they're both anonymous and have the same location.
-sameWildCard :: Eq name
-             => Located (HsWildCardInfo name)
+-- Two wild cards are the same when they have the same location
+sameWildCard :: Located (HsWildCardInfo name)
              -> Located (HsWildCardInfo name) -> Bool
 sameWildCard (L l1 (AnonWildCard _))   (L l2 (AnonWildCard _))   = l1 == l2
-sameWildCard (L _  (NamedWildCard (L _ n1)))
-             (L _  (NamedWildCard (L _ n2))) = n1 == n2
-sameWildCard _ _ = False
-
-sameNamedWildCard :: Eq name
-                  => Located (HsWildCardInfo name)
-                  -> Located (HsWildCardInfo name) -> Bool
-sameNamedWildCard (L _  (NamedWildCard (L _ n1)))
-                  (L _  (NamedWildCard (L _ n2))) = n1 == n2
-sameNamedWildCard _ _ = False
 
 splitHsAppTys :: LHsType Name -> [LHsType Name] -> (LHsType Name, [LHsType Name])
   -- no need to worry about HsAppsTy here
@@ -1030,9 +1045,8 @@ instance (Outputable thing) => Outputable (HsImplicitBndrs name thing) where
 instance (Outputable thing) => Outputable (HsWildCardBndrs name thing) where
     ppr (HsWC { hswc_body = ty }) = ppr ty
 
-instance (Outputable name) => Outputable (HsWildCardInfo name) where
+instance Outputable (HsWildCardInfo name) where
     ppr (AnonWildCard _)  = char '_'
-    ppr (NamedWildCard n) = ppr n
 
 pprHsForAll :: OutputableBndr name => [LHsTyVarBndr name] -> LHsContext name -> SDoc
 pprHsForAll = pprHsForAllExtra Nothing
@@ -1145,7 +1159,6 @@ ppr_mono_ty _    (HsExplicitListTy _ tys) = quote $ brackets (interpp'SP tys)
 ppr_mono_ty _    (HsExplicitTupleTy _ tys) = quote $ parens (interpp'SP tys)
 ppr_mono_ty _    (HsTyLit t)         = ppr_tylit t
 ppr_mono_ty _    (HsWildCardTy (AnonWildCard _))     = char '_'
-ppr_mono_ty _    (HsWildCardTy (NamedWildCard name)) = ppr name
 
 ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2)
   = maybeParen ctxt_prec TyOpPrec $
index 392aeda..2b22288 100644 (file)
@@ -89,7 +89,7 @@ templateHaskellNames = [
     forallTName, varTName, conTName, appTName, equalityTName,
     tupleTName, unboxedTupleTName, arrowTName, listTName, sigTName, litTName,
     promotedTName, promotedTupleTName, promotedNilTName, promotedConsTName,
-    wildCardTName, namedWildCardTName,
+    wildCardTName,
     -- TyLit
     numTyLitName, strTyLitName,
     -- TyVarBndr
@@ -391,7 +391,7 @@ forallTName, varTName, conTName, tupleTName, unboxedTupleTName, arrowTName,
     listTName, appTName, sigTName, equalityTName, litTName,
     promotedTName, promotedTupleTName,
     promotedNilTName, promotedConsTName,
-    wildCardTName, namedWildCardTName :: Name
+    wildCardTName :: Name
 forallTName         = libFun (fsLit "forallT")        forallTIdKey
 varTName            = libFun (fsLit "varT")           varTIdKey
 conTName            = libFun (fsLit "conT")           conTIdKey
@@ -408,8 +408,6 @@ promotedTupleTName  = libFun (fsLit "promotedTupleT") promotedTupleTIdKey
 promotedNilTName    = libFun (fsLit "promotedNilT")   promotedNilTIdKey
 promotedConsTName   = libFun (fsLit "promotedConsT")  promotedConsTIdKey
 wildCardTName       = libFun (fsLit "wildCardT")      wildCardTIdKey
-namedWildCardTName  = libFun (fsLit "namedWildCardT") namedWildCardTIdKey
-
 
 -- data TyLit = ...
 numTyLitName, strTyLitName :: Name
@@ -849,7 +847,7 @@ forallTIdKey, varTIdKey, conTIdKey, tupleTIdKey, unboxedTupleTIdKey, arrowTIdKey
     listTIdKey, appTIdKey, sigTIdKey, equalityTIdKey, litTIdKey,
     promotedTIdKey, promotedTupleTIdKey,
     promotedNilTIdKey, promotedConsTIdKey,
-    wildCardTIdKey, namedWildCardTIdKey :: Unique
+    wildCardTIdKey :: Unique
 forallTIdKey        = mkPreludeMiscIdUnique 380
 varTIdKey           = mkPreludeMiscIdUnique 381
 conTIdKey           = mkPreludeMiscIdUnique 382
@@ -866,7 +864,6 @@ promotedTupleTIdKey = mkPreludeMiscIdUnique 392
 promotedNilTIdKey   = mkPreludeMiscIdUnique 393
 promotedConsTIdKey  = mkPreludeMiscIdUnique 394
 wildCardTIdKey      = mkPreludeMiscIdUnique 395
-namedWildCardTIdKey = mkPreludeMiscIdUnique 396
 
 -- data TyLit = ...
 numTyLitIdKey, strTyLitIdKey :: Unique
index d139091..9b48219 100644 (file)
@@ -1667,7 +1667,7 @@ 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) }
index 2fc581e..1731ef7 100644 (file)
@@ -118,73 +118,44 @@ rnHsWcType ctxt wc_ty@(HsWC { hswc_body = hs_ty })
        ; rn_hs_wc_type ctxt wc_ty nwc_rdrs $ \ wc_ty' ->
          return (wc_ty', emptyFVs) }
 
--- | Finds free type and kind variables in a type, without duplicates and
--- variables that are already in LocalRdrEnv.
-extract_filtered_rdr_ty_vars :: LHsType RdrName -> RnM FreeKiTyVars
-extract_filtered_rdr_ty_vars hs_ty
-  = do { rdr_env <- getLocalRdrEnv
-       ; filterInScope rdr_env <$> extractHsTyRdrTyVars hs_ty }
-
--- | When the NamedWildCards extension is enabled, removes type variables
--- that start with an underscore from the FreeKiTyVars in the argument
--- and returns them in a separate list.
--- When the extension is disabled, the function returns the argument and
--- empty list.
--- See Note [Renaming named wild cards]
-partition_nwcs :: FreeKiTyVars -> RnM (FreeKiTyVars, [Located RdrName])
-partition_nwcs free_vars@(FKTV { fktv_tys = tys, fktv_all = all })
-  = do { wildcards_enabled <- fmap (xopt LangExt.NamedWildCards) getDynFlags
-       ; let (nwcs, no_nwcs) =
-                if wildcards_enabled
-                then partition (startsWithUnderscore . rdrNameOcc . unLoc) tys
-                else ([], tys)
-             free_vars' = free_vars { fktv_tys = no_nwcs
-                                    , fktv_all = all \\ nwcs }
-       ; return (free_vars', nwcs) }
-
 -- | Renames a type with wild card binders.
 -- Expects a list of names of type variables that should be replaced with
 -- named wild cards. (See Note [Renaming named wild cards])
 -- Although the parser does not create named wild cards, it is possible to find
 -- them in declaration splices, so the function tries to collect them.
-rn_hs_wc_type :: HsDocContext -> LHsWcType RdrName -> [Located RdrName]
+rn_hs_wc_type :: HsDocContext -> LHsWcType RdrName
+              -> [Located RdrName]  -- Named wildcards
               -> (LHsWcType Name -> RnM (a, FreeVars))
               -> RnM (a, FreeVars)
 rn_hs_wc_type ctxt (HsWC { hswc_body = hs_ty }) nwc_rdrs thing_inside
-  = do { let nwc_collected = collectNamedWildCards hs_ty
-       -- the parser doesn't generate named wcs, but they may be in splices
-       ; rdr_env <- getLocalRdrEnv
-       ; nwcs <- sequence [ newLocalBndrRn lrdr
-                          | lrdr@(L _ rdr) <- nwc_collected ++ nwc_rdrs
-                          , not (inScope rdr_env rdr) ]
-       ; setLocalRdrEnv (extendLocalRdrEnvNwcs rdr_env nwcs) $
-         bindLocalNamesFV nwcs $
-    do { (wc_ty, fvs1) <- rnWcSigTy ctxt hs_ty
+  = do { nwcs <- mapM newLocalBndrRn nwc_rdrs
+       ; bindLocalNamesFV nwcs $
+    do { let env = RTKE { rtke_level = TypeLevel
+                        , rtke_what  = RnTypeBody
+                        , rtke_nwcs  = mkNameSet nwcs
+                        , rtke_ctxt  = ctxt }
+       ; (wc_ty, fvs1) <- rnWcSigTy env hs_ty
        ; let wc_ty' :: HsWildCardBndrs Name (LHsType Name)
              wc_ty' = wc_ty { hswc_wcs = nwcs ++ hswc_wcs wc_ty }
        ; (res, fvs2) <- thing_inside wc_ty'
        ; return (res, fvs1 `plusFV` fvs2) } }
 
-rnWcSigTy :: HsDocContext -> LHsType RdrName
+rnWcSigTy :: RnTyKiEnv -> LHsType RdrName
           -> RnM (LHsWcType Name, FreeVars)
 -- ^ Renames just the top level of a type signature
 -- It's exactly like rnHsTyKi, except that it uses rnWcSigContext
 -- on a qualified type, and return info on any extra-constraints
 -- wildcard.  Some code duplication, but no big deal.
-rnWcSigTy ctxt (L loc hs_ty@(HsForAllTy { hst_bndrs = tvs, hst_body = hs_tau }))
-  = bindLHsTyVarBndrs ctxt Nothing [] tvs $ \ _ tvs' ->
-    do { lcl_env <- getLocalRdrEnv
-       ; let explicitly_bound = fmap hsLTyVarName tvs'
-       ; setLocalRdrEnv (delLocalRdrEnvNwcs lcl_env explicitly_bound) $
-           -- See Note [Renaming named wild cards]
-    do { (hs_tau', fvs) <- rnWcSigTy ctxt hs_tau
+rnWcSigTy env (L loc hs_ty@(HsForAllTy { hst_bndrs = tvs, hst_body = hs_tau }))
+  = bindLHsTyVarBndrs (rtke_ctxt env) Nothing [] tvs $ \ _ tvs' ->
+    do { (hs_tau', fvs) <- rnWcSigTy env hs_tau
        ; warnUnusedForAlls (inTypeDoc hs_ty) tvs' fvs
        ; let hs_ty' = HsForAllTy { hst_bndrs = tvs', hst_body = hswc_body hs_tau' }
-       ; return ( hs_tau' { hswc_body = L loc hs_ty' }, fvs) } }
+       ; return ( hs_tau' { hswc_body = L loc hs_ty' }, fvs) }
 
-rnWcSigTy ctxt (L loc (HsQualTy { hst_ctxt = hs_ctxt, hst_body = tau }))
-  = do { (hs_ctxt', fvs1) <- rnWcSigContext ctxt hs_ctxt
-       ; (tau',     fvs2) <- rnLHsType ctxt tau
+rnWcSigTy env (L loc (HsQualTy { hst_ctxt = hs_ctxt, hst_body = tau }))
+  = do { (hs_ctxt', fvs1) <- rnWcSigContext env hs_ctxt
+       ; (tau',     fvs2) <- rnLHsTyKi env tau
        ; let awcs_tau = collectAnonWildCards tau'
              hs_ty'   = HsQualTy { hst_ctxt = hswc_body hs_ctxt'
                                  , hst_body = tau' }
@@ -193,50 +164,78 @@ rnWcSigTy ctxt (L loc (HsQualTy { hst_ctxt = hs_ctxt, hst_body = tau }))
                        , hswc_body = L loc hs_ty' }
                 , fvs1 `plusFV` fvs2) }
 
-rnWcSigTy ctxt hs_ty
-  = do { (hs_ty', fvs) <- rnLHsType ctxt hs_ty
+rnWcSigTy env hs_ty
+  = do { (hs_ty', fvs) <- rnLHsTyKi env hs_ty
        ; return (HsWC { hswc_wcs = collectAnonWildCards hs_ty'
                       , hswc_ctx = Nothing
                       , hswc_body = hs_ty' }
                 , fvs) }
 
-rnWcSigContext :: HsDocContext -> LHsContext RdrName
+rnWcSigContext :: RnTyKiEnv -> LHsContext RdrName
                -> RnM (HsWildCardBndrs Name (LHsContext Name), FreeVars)
-rnWcSigContext ctxt (L loc hs_ctxt)
-  = getLocalRdrEnv >>= rn_wc_sig_context
+rnWcSigContext env (L loc hs_ctxt)
+  | Just (hs_ctxt1, hs_ctxt_last) <- snocView hs_ctxt
+  , L lx (HsWildCardTy wc) <- ignoreParens hs_ctxt_last
+  = do { (hs_ctxt1', fvs) <- mapFvRn rn_top_constraint hs_ctxt1
+       ; setSrcSpan lx $ checkExtraConstraintWildCard env wc
+       ; wc' <- rnAnonWildCard wc
+       ; let hs_ctxt' = hs_ctxt1' ++ [L lx (HsWildCardTy wc')]
+             awcs     = concatMap collectAnonWildCards hs_ctxt1'
+             -- NB: *not* including the extra-constraint wildcard
+       ; return ( HsWC { hswc_wcs = awcs
+                       , hswc_ctx = Just lx
+                       , hswc_body = L loc hs_ctxt' }
+                , fvs ) }
+  | otherwise
+  = do { (hs_ctxt', fvs) <- mapFvRn rn_top_constraint hs_ctxt
+       ; return (HsWC { hswc_wcs = concatMap collectAnonWildCards hs_ctxt'
+                      , hswc_ctx = Nothing
+                      , hswc_body = L loc hs_ctxt' }, fvs) }
   where
-    rn_wc_sig_context :: LocalRdrEnv
-                      -> RnM (HsWildCardBndrs Name (LHsContext Name), FreeVars)
-    rn_wc_sig_context lcl_env
-      | Just (hs_ctxt1, hs_ctxt_last) <- snocView hs_ctxt
-      , L lx (HsWildCardTy wc) <- (to_nwc lcl_env . ignoreParens) hs_ctxt_last
-      = do { (hs_ctxt1', fvs) <- mapFvRn rn_top_constraint hs_ctxt1
-           ; wc'              <- setSrcSpan lx $
-                                 rnExtraConstraintWildCard ctxt wc
-           ; let hs_ctxt' = hs_ctxt1' ++ [L lx (HsWildCardTy wc')]
-                 awcs     = concatMap collectAnonWildCards hs_ctxt1'
-                 -- NB: *not* including the extra-constraint wildcard
-           ; return ( HsWC { hswc_wcs = awcs
-                           , hswc_ctx = Just lx
-                           , hswc_body = L loc hs_ctxt' }
-                    , fvs ) }
-      | otherwise
-      = do { (hs_ctxt', fvs) <- mapFvRn rn_top_constraint hs_ctxt
-           ; return (HsWC { hswc_wcs = concatMap collectAnonWildCards hs_ctxt'
-                          , hswc_ctx = Nothing
-                          , hswc_body = L loc hs_ctxt' }, fvs) }
-
-    to_nwc :: LocalRdrEnv -> LHsType RdrName -> LHsType RdrName
-    to_nwc _  lnwc@(L _ (HsWildCardTy {})) = lnwc
-    to_nwc lcl_env (L loc (HsTyVar lname@(L _ rdr_name)))
-      | rdr_name `inLocalRdrEnvNwcsRdrName` lcl_env
-      = L loc (HsWildCardTy (NamedWildCard lname))
-    to_nwc _ lt = lt
-
-    rn_top_constraint = rnLHsTyKi RnTopConstraint ctxt
+    rn_top_constraint = rnLHsTyKi (env { rtke_what = RnTopConstraint })
 
 
-{- ******************************************************
+-- | extract_filtered finds free type and kind variables in a type,
+--     without duplicates, and
+--     without variables that are already in scope in LocalRdrEnv
+--   NB: this includes named wildcards, which look like perfectly
+--       ordinary type variables at this point
+extract_filtered_rdr_ty_vars :: LHsType RdrName -> RnM FreeKiTyVars
+extract_filtered_rdr_ty_vars hs_ty
+  = do { rdr_env <- getLocalRdrEnv
+       ; filterInScope rdr_env <$> extractHsTyRdrTyVars hs_ty }
+
+-- | When the NamedWildCards extension is enabled, partition_nwcs
+-- removes type variables that start with an underscore from the
+-- FreeKiTyVars in the argument and returns them in a separate list.
+-- When the extension is disabled, the function returns the argument
+-- and empty list.  See Note [Renaming named wild cards]
+partition_nwcs :: FreeKiTyVars -> RnM (FreeKiTyVars, [Located RdrName])
+partition_nwcs free_vars@(FKTV { fktv_tys = tys, fktv_all = all })
+  = do { wildcards_enabled <- fmap (xopt LangExt.NamedWildCards) getDynFlags
+       ; let (nwcs, no_nwcs) | wildcards_enabled = partition is_wildcard tys
+                             | otherwise         = ([], tys)
+             free_vars' = free_vars { fktv_tys = no_nwcs
+                                    , fktv_all = all \\ nwcs }
+       ; return (free_vars', nwcs) }
+  where
+     is_wildcard :: Located RdrName -> Bool
+     is_wildcard rdr = startsWithUnderscore (rdrNameOcc (unLoc rdr))
+
+{- Note [Renaming named wild cards]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Identifiers starting with an underscore are always parsed as type variables.
+It is only here in the renamer that we give the special treatment.
+See Note [The wildcard story for types] in HsTypes.
+
+It's easy!  When we collect the implicitly bound type variables, ready
+to bring them into scope, and NamedWildCards is on, we partition the
+variables into the ones that start with an underscore (the named
+wildcards) and the rest. Then we just add them to the hswc_wcs field
+of the HsWildCardBndrs structure, and we are done.
+
+
+*********************************************************
 *                                                       *
            HsSigtype (i.e. no wildcards)
 *                                                       *
@@ -350,47 +349,55 @@ and
 as our lists. We can then do normal fixity resolution on these. The fixities
 must come along for the ride just so that the list stays in sync with the
 operators.
+-}
 
-Note [Renaming named wild cards]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Identifiers starting with an underscore are always parsed as type variables.
-(Parser.y) When the NamedWildCards extension is enabled, the renamer replaces
-those variables with named wild cards.
+data RnTyKiEnv
+  = RTKE { rtke_ctxt  :: HsDocContext
+         , rtke_level :: TypeOrKind  -- Am I renaming a type or a kind?
+         , rtke_what  :: RnTyKiWhat  -- And within that what am I renaming?
+         , rtke_nwcs  :: NameSet     -- These are the in-scope named wildcards
+    }
 
-The NameSet lre_nwcs in LocalRdrEnv is used to keep the names of the type
-variables that should be replaced with named wild cards. The set is filled only
-in functions that return a LHsWcType and thus expect to find wild cards.
-In other functions, the set remains empty and the wild cards are not created.
-Because of this, the replacement does not occur in contexts where the wild
-cards are not expected, like data type declarations or type synonyms.
-(See the comments in Trac #10982)
+data RnTyKiWhat = RnTypeBody
+                | RnTopConstraint   -- Top-level context of HsSigWcTypes
+                | RnConstraint      -- All other constraints
 
-While renaming HsForAllTy (rnWcSigTy, rnHsTyKi), the explicitly bound names are
-removed from the lre_nwcs NameSet. As a result, they are not replaced in the
-quantifier body even if they start with an underscore. (Trac #11098) Eg
+instance Outputable RnTyKiEnv where
+  ppr (RTKE { rtke_level = lev, rtke_what = what
+            , rtke_nwcs = wcs, rtke_ctxt = ctxt })
+    = ptext (sLit "RTKE")
+      <+> braces (sep [ ppr lev, ppr what, ppr wcs
+                      , pprHsDocContext ctxt ])
 
-    qux :: _a -> (forall _a . _a -> _a) -> _a
+instance Outputable RnTyKiWhat where
+  ppr RnTypeBody      = text "RnTypeBody"
+  ppr RnTopConstraint = text "RnTopConstraint"
+  ppr RnConstraint    = text "RnConstraint"
 
-The _a bound by forall is a tyvar, the _a outside the parens are wild cards.
--}
+mkTyKiEnv :: HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
+mkTyKiEnv cxt level what
+ = RTKE { rtke_level = level, rtke_nwcs = emptyNameSet
+        , rtke_what = what, rtke_ctxt = cxt }
 
-rnLHsTyKi  :: RnTyKiWhat
-           -> HsDocContext -> LHsType RdrName -> RnM (LHsType Name, FreeVars)
-rnLHsTyKi what doc (L loc ty)
-  = setSrcSpan loc $
-    do { (ty', fvs) <- rnHsTyKi what doc ty
-       ; return (L loc ty', fvs) }
+isRnKindLevel :: RnTyKiEnv -> Bool
+isRnKindLevel (RTKE { rtke_level = KindLevel }) = True
+isRnKindLevel _                                 = False
 
+--------------
 rnLHsType  :: HsDocContext -> LHsType RdrName -> RnM (LHsType Name, FreeVars)
-rnLHsType cxt ty = -- pprTrace "rnHsType" (pprHsDocContext cxt $$ ppr ty) $
-                   rnLHsTyKi (RnTypeBody TypeLevel) cxt ty
+rnLHsType ctxt ty = rnLHsTyKi (mkTyKiEnv ctxt TypeLevel RnTypeBody) ty
 
-rnLHsPred  :: RnTyKiWhat -> HsDocContext -> LHsType RdrName -> RnM (LHsType Name, FreeVars)
-rnLHsPred (RnTypeBody level) = rnLHsTyKi (RnConstraint level)
-rnLHsPred what               = rnLHsTyKi what
+rnLHsTypes :: HsDocContext -> [LHsType RdrName] -> RnM ([LHsType Name], FreeVars)
+rnLHsTypes doc tys = mapFvRn (rnLHsType doc) tys
+
+rnHsType  :: HsDocContext -> HsType RdrName -> RnM (HsType Name, FreeVars)
+rnHsType ctxt ty = rnHsTyKi (mkTyKiEnv ctxt TypeLevel RnTypeBody) ty
 
 rnLHsKind  :: HsDocContext -> LHsKind RdrName -> RnM (LHsKind Name, FreeVars)
-rnLHsKind = rnLHsTyKi (RnTypeBody KindLevel)
+rnLHsKind ctxt kind = rnLHsTyKi (mkTyKiEnv ctxt KindLevel RnTypeBody) kind
+
+rnHsKind  :: HsDocContext -> HsKind RdrName -> RnM (HsKind Name, FreeVars)
+rnHsKind ctxt kind = rnHsTyKi  (mkTyKiEnv ctxt KindLevel RnTypeBody) kind
 
 rnLHsMaybeKind  :: HsDocContext -> Maybe (LHsKind RdrName)
                 -> RnM (Maybe (LHsKind Name), FreeVars)
@@ -400,89 +407,82 @@ rnLHsMaybeKind doc (Just kind)
   = do { (kind', fvs) <- rnLHsKind doc kind
        ; return (Just kind', fvs) }
 
-rnHsType  :: HsDocContext -> HsType RdrName -> RnM (HsType Name, FreeVars)
-rnHsType cxt ty = rnHsTyKi (RnTypeBody TypeLevel) cxt ty
+--------------
+rnTyKiContext :: RnTyKiEnv -> LHsContext RdrName -> RnM (LHsContext Name, FreeVars)
+rnTyKiContext env (L loc cxt)
+  = do { traceRn (text "rncontext" <+> ppr cxt)
+       ; let env' = env { rtke_what = RnConstraint }
+       ; (cxt', fvs) <- mapFvRn (rnLHsTyKi env') cxt
+       ; return (L loc cxt', fvs) }
+  where
 
-rnHsKind  :: HsDocContext -> HsKind RdrName -> RnM (HsKind Name, FreeVars)
-rnHsKind = rnHsTyKi (RnTypeBody KindLevel)
+rnContext :: HsDocContext -> LHsContext RdrName -> RnM (LHsContext Name, FreeVars)
+rnContext doc theta = rnTyKiContext (mkTyKiEnv doc TypeLevel RnConstraint) theta
 
-data RnTyKiWhat = RnTypeBody TypeOrKind
-                | RnTopConstraint           -- Top-level context of HsSigWcTypes
-                | RnConstraint TypeOrKind   -- All other constraints
+--------------
+rnLHsTyKi  :: RnTyKiEnv -> LHsType RdrName -> RnM (LHsType Name, FreeVars)
+rnLHsTyKi env (L loc ty)
+  = setSrcSpan loc $
+    do { (ty', fvs) <- rnHsTyKi env ty
+       ; return (L loc ty', fvs) }
 
-instance Outputable RnTyKiWhat where
-  ppr (RnTypeBody lev)   = text "RnTypeBody" <+> ppr lev
-  ppr RnTopConstraint    = text "RnTopConstraint"
-  ppr (RnConstraint lev) = text "RnConstraint" <+> ppr lev
-
-isRnKindLevel :: RnTyKiWhat -> Bool
-isRnKindLevel (RnTypeBody KindLevel)   = True
-isRnKindLevel (RnConstraint KindLevel) = True
-isRnKindLevel _                        = False
-
-rnHsTyKi :: RnTyKiWhat -> HsDocContext -> HsType RdrName -> RnM (HsType Name, FreeVars)
-
-rnHsTyKi what doc ty@(HsForAllTy { hst_bndrs = tyvars, hst_body  = tau })
-  = do { checkTypeInType what ty
-       ; bindLHsTyVarBndrs doc Nothing [] tyvars $ \ _ tyvars' ->
-    do { lcl_env <- getLocalRdrEnv
-       ; let explicitly_bound = fmap hsLTyVarName tyvars'
-       ; setLocalRdrEnv (delLocalRdrEnvNwcs lcl_env explicitly_bound) $
-           -- See Note [Renaming named wild cards]
-    do { (tau',  fvs) <- rnLHsTyKi what doc tau
+rnHsTyKi :: RnTyKiEnv -> HsType RdrName -> RnM (HsType Name, FreeVars)
+
+rnHsTyKi env ty@(HsForAllTy { hst_bndrs = tyvars, hst_body  = tau })
+  = do { checkTypeInType env ty
+       ; bindLHsTyVarBndrs (rtke_ctxt env) Nothing [] tyvars $ \ _ tyvars' ->
+    do { (tau',  fvs) <- rnLHsTyKi env tau
        ; warnUnusedForAlls (inTypeDoc ty) tyvars' fvs
        ; return ( HsForAllTy { hst_bndrs = tyvars', hst_body =  tau' }
-                , fvs) } } }
+                , fvs) } }
 
-rnHsTyKi what doc ty@(HsQualTy { hst_ctxt = lctxt
-                               , hst_body = tau })
-  = do { checkTypeInType what ty
-       ; (ctxt', fvs1) <- rnTyKiContext what doc lctxt
-       ; (tau',  fvs2) <- rnLHsTyKi what doc tau
+rnHsTyKi env ty@(HsQualTy { hst_ctxt = lctxt
+                          , hst_body = tau })
+  = do { checkTypeInType env ty
+       ; (ctxt', fvs1) <- rnTyKiContext env lctxt
+       ; (tau',  fvs2) <- rnLHsTyKi env tau
        ; return (HsQualTy { hst_ctxt = ctxt', hst_body =  tau' }
                 , fvs1 `plusFV` fvs2) }
 
-rnHsTyKi what doc (HsTyVar lname@(L loc rdr_name))
-  = do { lcl_env <- getLocalRdrEnv
-           -- See Note [Renaming named wild cards]
-       ; if rdr_name `inLocalRdrEnvNwcsRdrName` lcl_env
-         then rnHsTyKi what doc (HsWildCardTy (NamedWildCard lname))
-         else do { name <- rnTyVar what rdr_name
-                 ; return (HsTyVar (L loc name), unitFV name) } }
+rnHsTyKi env (HsTyVar (L loc rdr_name))
+  = do { name <- rnTyVar env rdr_name
+       ; return (HsTyVar (L loc name), unitFV name) }
 
-rnHsTyKi what doc ty@(HsOpTy ty1 l_op ty2)
+rnHsTyKi env ty@(HsOpTy ty1 l_op ty2)
   = setSrcSpan (getLoc l_op) $
-    do  { (l_op', fvs1) <- rnHsTyOp what ty l_op
+    do  { (l_op', fvs1) <- rnHsTyOp env ty l_op
         ; fix   <- lookupTyFixityRn l_op'
-        ; (ty1', fvs2) <- rnLHsTyKi what doc ty1
-        ; (ty2', fvs3) <- rnLHsTyKi what doc ty2
+        ; (ty1', fvs2) <- rnLHsTyKi env ty1
+        ; (ty2', fvs3) <- rnLHsTyKi env ty2
         ; res_ty <- mkHsOpTyRn (\t1 t2 -> HsOpTy t1 l_op' t2)
                                (unLoc l_op') fix ty1' ty2'
         ; return (res_ty, plusFVs [fvs1, fvs2, fvs3]) }
 
-rnHsTyKi what doc (HsParTy ty)
-  = do { (ty', fvs) <- rnLHsTyKi what doc ty
+rnHsTyKi env (HsParTy ty)
+  = do { (ty', fvs) <- rnLHsTyKi env ty
        ; return (HsParTy ty', fvs) }
 
-rnHsTyKi _ doc (HsBangTy b ty)
-  = do { (ty', fvs) <- rnLHsType doc ty
+rnHsTyKi env (HsBangTy b ty)
+  = do { (ty', fvs) <- rnLHsTyKi env ty
        ; return (HsBangTy b ty', fvs) }
 
-rnHsTyKi _ doc@(ConDeclCtx names) (HsRecTy flds)
-  = do { fls <- concatMapM (lookupConstructorFields . unLoc) names
-       ; (flds', fvs) <- rnConDeclFields fls doc flds
-       ; return (HsRecTy flds', fvs) }
-
-rnHsTyKi _ doc ty@(HsRecTy flds)
-  = do { addErr (hang (ptext (sLit "Record syntax is illegal here:"))
-                    2 (ppr ty))
-       ; (flds', fvs) <- rnConDeclFields [] doc flds
+rnHsTyKi env ty@(HsRecTy flds)
+  = do { let ctxt = rtke_ctxt env
+       ; fls          <- get_fields ctxt
+       ; (flds', fvs) <- rnConDeclFields ctxt fls flds
        ; return (HsRecTy flds', fvs) }
-
-rnHsTyKi what doc (HsFunTy ty1 ty2)
-  = do { (ty1', fvs1) <- rnLHsTyKi what doc ty1
+  where
+    get_fields (ConDeclCtx names)
+      = concatMapM (lookupConstructorFields . unLoc) names
+    get_fields _
+      = do { addErr (hang (ptext (sLit "Record syntax is illegal here:"))
+                                   2 (ppr ty))
+           ; return [] }
+
+rnHsTyKi env (HsFunTy ty1 ty2)
+  = do { (ty1', fvs1) <- rnLHsTyKi env ty1
         -- Might find a for-all as the arg of a function type
-       ; (ty2', fvs2) <- rnLHsTyKi what doc ty2
+       ; (ty2', fvs2) <- rnLHsTyKi env ty2
         -- Or as the result.  This happens when reading Prelude.hi
         -- when we find return :: forall m. Monad m -> forall a. a -> m a
 
@@ -490,54 +490,54 @@ rnHsTyKi what doc (HsFunTy ty1 ty2)
        ; res_ty <- mkHsOpTyRn HsFunTy funTyConName funTyFixity ty1' ty2'
        ; return (res_ty, fvs1 `plusFV` fvs2) }
 
-rnHsTyKi what doc listTy@(HsListTy ty)
+rnHsTyKi env listTy@(HsListTy ty)
   = do { data_kinds <- xoptM LangExt.DataKinds
-       ; when (not data_kinds && isRnKindLevel what)
-              (addErr (dataKindsErr what listTy))
-       ; (ty', fvs) <- rnLHsTyKi what doc ty
+       ; when (not data_kinds && isRnKindLevel env)
+              (addErr (dataKindsErr env listTy))
+       ; (ty', fvs) <- rnLHsTyKi env ty
        ; return (HsListTy ty', fvs) }
 
-rnHsTyKi what doc t@(HsKindSig ty k)
-  = do { checkTypeInType what t
+rnHsTyKi env t@(HsKindSig ty k)
+  = do { checkTypeInType env t
        ; kind_sigs_ok <- xoptM LangExt.KindSignatures
-       ; unless kind_sigs_ok (badKindSigErr doc ty)
-       ; (ty', fvs1) <- rnLHsTyKi what doc ty
-       ; (k', fvs2) <- rnLHsKind doc k
+       ; unless kind_sigs_ok (badKindSigErr (rtke_ctxt env) ty)
+       ; (ty', fvs1) <- rnLHsTyKi env ty
+       ; (k', fvs2)  <- rnLHsTyKi (env { rtke_level = KindLevel }) k
        ; return (HsKindSig ty' k', fvs1 `plusFV` fvs2) }
 
-rnHsTyKi what doc t@(HsPArrTy ty)
-  = do { notInKinds what t
-       ; (ty', fvs) <- rnLHsType doc ty
+rnHsTyKi env t@(HsPArrTy ty)
+  = do { notInKinds env t
+       ; (ty', fvs) <- rnLHsTyKi env ty
        ; return (HsPArrTy ty', fvs) }
 
 -- Unboxed tuples are allowed to have poly-typed arguments.  These
 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
-rnHsTyKi what doc tupleTy@(HsTupleTy tup_con tys)
+rnHsTyKi env tupleTy@(HsTupleTy tup_con tys)
   = do { data_kinds <- xoptM LangExt.DataKinds
-       ; when (not data_kinds && isRnKindLevel what)
-              (addErr (dataKindsErr what tupleTy))
-       ; (tys', fvs) <- mapFvRn (rnLHsTyKi what doc) tys
+       ; when (not data_kinds && isRnKindLevel env)
+              (addErr (dataKindsErr env tupleTy))
+       ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
        ; return (HsTupleTy tup_con tys', fvs) }
 
 -- Ensure that a type-level integer is nonnegative (#8306, #8412)
-rnHsTyKi what _ tyLit@(HsTyLit t)
+rnHsTyKi env tyLit@(HsTyLit t)
   = do { data_kinds <- xoptM LangExt.DataKinds
-       ; unless data_kinds (addErr (dataKindsErr what tyLit))
+       ; unless data_kinds (addErr (dataKindsErr env tyLit))
        ; when (negLit t) (addErr negLitErr)
-       ; checkTypeInType what tyLit
+       ; checkTypeInType env tyLit
        ; return (HsTyLit t, emptyFVs) }
   where
     negLit (HsStrTy _ _) = False
     negLit (HsNumTy _ i) = i < 0
     negLitErr = ptext (sLit "Illegal literal in type (type literals must not be negative):") <+> ppr tyLit
 
-rnHsTyKi isType doc overall_ty@(HsAppsTy tys)
+rnHsTyKi env overall_ty@(HsAppsTy tys)
   = do { -- Step 1: Break up the HsAppsTy into symbols and non-symbol regions
          let (non_syms, syms) = splitHsAppsTy tys
 
              -- Step 2: rename the pieces
-       ; (syms1, fvs1)      <- mapFvRn (rnHsTyOp isType overall_ty) syms
-       ; (non_syms1, fvs2)  <- (mapFvRn . mapFvRn) (rnLHsTyKi isType doc) non_syms
+       ; (syms1, fvs1)      <- mapFvRn (rnHsTyOp env overall_ty) syms
+       ; (non_syms1, fvs2)  <- (mapFvRn . mapFvRn) (rnLHsTyKi env) non_syms
 
              -- Step 3: deal with *. See Note [Dealing with *]
        ; let (non_syms2, syms2) = deal_with_star [] [] non_syms1 syms1
@@ -587,107 +587,78 @@ rnHsTyKi isType doc overall_ty@(HsAppsTy tys)
     build_res_ty [arg] [] = return arg
     build_res_ty _ _ = pprPanic "build_op_ty" (ppr overall_ty)
 
-rnHsTyKi what doc (HsAppTy ty1 ty2)
-  = do { (ty1', fvs1) <- rnLHsTyKi what doc ty1
-       ; (ty2', fvs2) <- rnLHsTyKi what doc ty2
+rnHsTyKi env (HsAppTy ty1 ty2)
+  = do { (ty1', fvs1) <- rnLHsTyKi env ty1
+       ; (ty2', fvs2) <- rnLHsTyKi env ty2
        ; return (HsAppTy ty1' ty2', fvs1 `plusFV` fvs2) }
 
-rnHsTyKi what doc t@(HsIParamTy n ty)
-  = do { notInKinds what t
-       ; (ty', fvs) <- rnLHsType doc ty
+rnHsTyKi env t@(HsIParamTy n ty)
+  = do { notInKinds env t
+       ; (ty', fvs) <- rnLHsTyKi env ty
        ; return (HsIParamTy n ty', fvs) }
 
-rnHsTyKi what doc t@(HsEqTy ty1 ty2)
-  = do { checkTypeInType what t
-       ; (ty1', fvs1) <- rnLHsTyKi what doc ty1
-       ; (ty2', fvs2) <- rnLHsTyKi what doc ty2
+rnHsTyKi env t@(HsEqTy ty1 ty2)
+  = do { checkTypeInType env t
+       ; (ty1', fvs1) <- rnLHsTyKi env ty1
+       ; (ty2', fvs2) <- rnLHsTyKi env ty2
        ; return (HsEqTy ty1' ty2', fvs1 `plusFV` fvs2) }
 
-rnHsTyKi _ (HsSpliceTy sp k)
+rnHsTyKi _ (HsSpliceTy sp k)
   = rnSpliceType sp k
 
-rnHsTyKi _ doc (HsDocTy ty haddock_doc)
-  = do { (ty', fvs) <- rnLHsType doc ty
+rnHsTyKi env (HsDocTy ty haddock_doc)
+  = do { (ty', fvs) <- rnLHsTyKi env ty
        ; haddock_doc' <- rnLHsDoc haddock_doc
        ; return (HsDocTy ty' haddock_doc', fvs) }
 
-rnHsTyKi _ (HsCoreTy ty)
+rnHsTyKi _ (HsCoreTy ty)
   = return (HsCoreTy ty, emptyFVs)
     -- The emptyFVs probably isn't quite right
     -- but I don't think it matters
 
-rnHsTyKi what doc ty@(HsExplicitListTy k tys)
-  = do { checkTypeInType what ty
+rnHsTyKi env ty@(HsExplicitListTy k tys)
+  = do { checkTypeInType env ty
        ; data_kinds <- xoptM LangExt.DataKinds
-       ; unless data_kinds (addErr (dataKindsErr what ty))
-       ; (tys', fvs) <- mapFvRn (rnLHsTyKi what doc) tys
+       ; unless data_kinds (addErr (dataKindsErr env ty))
+       ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
        ; return (HsExplicitListTy k tys', fvs) }
 
-rnHsTyKi what doc ty@(HsExplicitTupleTy kis tys)
-  = do { checkTypeInType what ty
+rnHsTyKi env ty@(HsExplicitTupleTy kis tys)
+  = do { checkTypeInType env ty
        ; data_kinds <- xoptM LangExt.DataKinds
-       ; unless data_kinds (addErr (dataKindsErr what ty))
-       ; (tys', fvs) <- mapFvRn (rnLHsTyKi what doc) tys
+       ; unless data_kinds (addErr (dataKindsErr env ty))
+       ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
        ; return (HsExplicitTupleTy kis tys', fvs) }
 
-rnHsTyKi what ctxt (HsWildCardTy wc)
-  = do { wc' <- case mb_bad of
-           Just msg -> do { addErr (wildCardMsg ctxt msg)
-                          ; discardErrs (rnWildCard ctxt wc) }
-                          -- discardErrs: avoid reporting
-                          -- a second error
-           Nothing  -> rnWildCard ctxt wc
-
-       ; traceRn (text "rnHsTyKi wild" <+> ppr wc <+> ppr (isJust mb_bad))
+rnHsTyKi env (HsWildCardTy wc)
+  = do { checkAnonWildCard env wc
+       ; wc' <- rnAnonWildCard wc
        ; return (HsWildCardTy wc', emptyFVs) }
          -- emptyFVs: this occurrence does not refer to a
          --           user-written binding site, so don't treat
          --           it as a free variable
-  where
-    mb_bad :: Maybe SDoc
-    mb_bad | not (wildCardsAllowed ctxt)
-           = Just (notAllowed wc)
-           | otherwise
-           = case what of
-               RnTypeBody _    -> Nothing
-               RnConstraint _  -> Just constraint_msg
-               RnTopConstraint -> case wc of
-                     AnonWildCard {}  -> Just constraint_msg
-                     NamedWildCard {} -> Nothing
-
-    constraint_msg = hang (notAllowed wc <+> ptext (sLit "in a constraint"))
-                        2 hint_msg
-
-    hint_msg = case wc of
-       NamedWildCard {} -> empty
-       AnonWildCard {}  -> vcat [ ptext (sLit "except as the last top-level constraint of a type signature")
-                                , nest 2 (ptext (sLit "e.g  f :: (Eq a, _) => blah")) ]
-
-notAllowed :: HsWildCardInfo RdrName -> SDoc
-notAllowed wc =  ptext (sLit "Wildcard") <+> quotes (ppr wc)
-                 <+> ptext (sLit "not allowed")
-
-wildCardMsg :: HsDocContext -> SDoc -> SDoc
-wildCardMsg ctxt doc
-  = vcat [doc, nest 2 (ptext (sLit "in") <+> pprHsDocContext ctxt)]
 
 --------------
-rnTyVar :: RnTyKiWhat -> RdrName -> RnM Name
-rnTyVar what rdr_name
-  | isRnKindLevel what = lookupKindOccRn rdr_name
-  | otherwise          = lookupTypeOccRn rdr_name
+rnTyVar :: RnTyKiEnv -> RdrName -> RnM Name
+rnTyVar env rdr_name
+  = do { name <- if   isRnKindLevel env
+                 then lookupKindOccRn rdr_name
+                 else lookupTypeOccRn rdr_name
+       ; checkNamedWildCard env name
+       ; return name }
 
 rnLTyVar :: Located RdrName -> RnM (Located Name)
+-- Called externally; does not deal with wildards
 rnLTyVar (L loc rdr_name)
   = do { tyvar <- lookupTypeOccRn rdr_name
        ; return (L loc tyvar) }
 
 --------------
 rnHsTyOp :: Outputable a
-         => RnTyKiWhat -> a -> Located RdrName -> RnM (Located Name, FreeVars)
-rnHsTyOp what overall_ty (L loc op)
+         => RnTyKiEnv -> a -> Located RdrName -> RnM (Located Name, FreeVars)
+rnHsTyOp env overall_ty (L loc op)
   = do { ops_ok <- xoptM LangExt.TypeOperators
-       ; op' <- rnTyVar what op
+       ; op' <- rnTyVar env op
        ; unless (ops_ok
                  || op' == starKindTyConName
                  || op' == unicodeStarKindTyConName
@@ -697,21 +668,76 @@ rnHsTyOp what overall_ty (L loc op)
        ; return (l_op', unitFV op') }
 
 --------------
-rnLHsTypes :: HsDocContext -> [LHsType RdrName]
-           -> RnM ([LHsType Name], FreeVars)
-rnLHsTypes doc tys = mapFvRn (rnLHsType doc) tys
+notAllowed :: SDoc -> SDoc
+notAllowed doc
+  = ptext (sLit "Wildcard") <+> quotes doc <+> ptext (sLit "not allowed")
+
+checkWildCard :: RnTyKiEnv -> Maybe SDoc -> RnM ()
+checkWildCard env (Just doc)
+  = addErr $ vcat [doc, nest 2 (ptext (sLit "in") <+> pprHsDocContext (rtke_ctxt env))]
+checkWildCard _ Nothing
+  = return ()
 
---------------
-extraConstraintWildCardsAllowed :: HsDocContext -> Bool
-extraConstraintWildCardsAllowed ctxt
-  = case ctxt of
+checkAnonWildCard :: RnTyKiEnv -> HsWildCardInfo RdrName -> RnM ()
+-- Report an error if an anonymoous wildcard is illegal here
+checkAnonWildCard env wc
+  = checkWildCard env mb_bad
+  where
+    mb_bad :: Maybe SDoc
+    mb_bad | not (wildCardsAllowed env)
+           = Just (notAllowed (ppr wc))
+           | otherwise
+           = case rtke_what env of
+               RnTypeBody      -> Nothing
+               RnConstraint    -> Just constraint_msg
+               RnTopConstraint -> Just constraint_msg
+
+    constraint_msg = hang (notAllowed (ppr wc) <+> ptext (sLit "in a constraint"))
+                        2 hint_msg
+    hint_msg = vcat [ ptext (sLit "except as the last top-level constraint of a type signature")
+                    , nest 2 (ptext (sLit "e.g  f :: (Eq a, _) => blah")) ]
+
+checkNamedWildCard :: RnTyKiEnv -> Name -> RnM ()
+-- Report an error if a named wildcard is illegal here
+checkNamedWildCard env name
+  = checkWildCard env mb_bad
+  where
+    mb_bad | not (name `elemNameSet` rtke_nwcs env)
+           = Nothing  -- Not a wildcard
+           | not (wildCardsAllowed env)
+           = Just (notAllowed (ppr name))
+           | otherwise
+           = case rtke_what env of
+               RnTypeBody      -> Nothing   -- Allowed
+               RnTopConstraint -> Nothing   -- Allowed
+               RnConstraint    -> Just constraint_msg
+    constraint_msg = notAllowed (ppr name) <+> ptext (sLit "in a constraint")
+
+checkExtraConstraintWildCard :: RnTyKiEnv -> HsWildCardInfo RdrName
+                             -> RnM ()
+-- Rename the extra-constraint spot in a type signature
+--    (blah, _) => type
+-- Check that extra-constraints are allowed at all, and
+-- if so that it's an anonymous wildcard
+checkExtraConstraintWildCard env wc
+  = checkWildCard env mb_bad
+  where
+    mb_bad | not (extraConstraintWildCardsAllowed env)
+           = Just (ptext (sLit "Extra-contraint wildcard") <+> quotes (ppr wc)
+                   <+> ptext (sLit "not allowed"))
+           | otherwise
+           = Nothing
+
+extraConstraintWildCardsAllowed :: RnTyKiEnv -> Bool
+extraConstraintWildCardsAllowed env
+  = case rtke_ctxt env of
       TypeSigCtx {}       -> True
       _                   -> False
 
-wildCardsAllowed :: HsDocContext -> Bool
+wildCardsAllowed :: RnTyKiEnv -> Bool
 -- ^ In what contexts are wildcards permitted
-wildCardsAllowed ctxt
-   = case ctxt of
+wildCardsAllowed env
+   = case rtke_ctxt env of
        TypeSigCtx {}       -> True
        TypBrCtx {}         -> True   -- Template Haskell quoted type
        SpliceTypeCtx {}    -> True   -- Result of a Template Haskell splice
@@ -722,56 +748,21 @@ wildCardsAllowed ctxt
        GHCiCtx {}          -> True
        _                   -> False
 
-rnExtraConstraintWildCard :: HsDocContext -> HsWildCardInfo RdrName
-                          -> RnM (HsWildCardInfo Name)
--- Rename the extra-constraint spot in a type signature
---    (blah, _) => type
--- Check that extra-constraints are allowed at all, and
--- if so that it's an anonymous wildcard
-rnExtraConstraintWildCard ctxt wc
-  = case mb_bad of
-      Nothing  -> rnWildCard ctxt wc
-      Just msg -> do { addErr (wildCardMsg ctxt msg)
-                     ; discardErrs (rnWildCard ctxt wc) }
-  where
-    mb_bad | not (extraConstraintWildCardsAllowed ctxt)
-           = Just (ptext (sLit "Extra-contraint wildcard") <+> quotes (ppr wc)
-                   <+> ptext (sLit "not allowed"))
-           | isNamedWildCard wc
-           = Just (hang (ptext (sLit "Named wildcard") <+> quotes (ppr wc)
-                         <+> ptext (sLit "not allowed as an extra-contraint"))
-                      2 (ptext (sLit "Use an anonymous wildcard instead")))
-           | otherwise
-           = Nothing
-
-rnWildCard :: HsDocContext -> HsWildCardInfo RdrName -> RnM (HsWildCardInfo Name)
-rnWildCard _ (AnonWildCard _)
+rnAnonWildCard :: HsWildCardInfo RdrName -> RnM (HsWildCardInfo Name)
+rnAnonWildCard (AnonWildCard _)
   = do { loc <- getSrcSpanM
        ; uniq <- newUnique
        ; let name = mkInternalName uniq (mkTyVarOcc "_") loc
        ; return (AnonWildCard (L loc name)) }
 
-rnWildCard ctxt wc@(NamedWildCard (L loc rdr_name))
-  -- NB: The parser only generates NamedWildCard if -XNamedWildCards
-  --     is on, so we don't need to check for that here
-  = do { mb_name <- lookupOccRn_maybe rdr_name
-       ; traceRn (text "rnWildCard named" <+> (ppr rdr_name $$ ppr mb_name))
-       ; case mb_name of
-           Just n  -> return (NamedWildCard (L loc n))
-           Nothing -> do { addErr msg  -- I'm not sure how this can happen
-                         ; return (NamedWildCard (L loc (mkUnboundNameRdr rdr_name))) } }
-  where
-    msg = wildCardMsg ctxt (notAllowed wc)
-
-
 ---------------
 -- | Ensures either that we're in a type or that -XTypeInType is set
 checkTypeInType :: Outputable ty
-                => RnTyKiWhat
+                => RnTyKiEnv
                 -> ty      -- ^ type
                 -> RnM ()
-checkTypeInType what ty
-  | isRnKindLevel what
+checkTypeInType env ty
+  | isRnKindLevel env
   = do { type_in_type <- xoptM LangExt.TypeInType
        ; unless type_in_type $
          addErr (text "Illegal kind:" <+> ppr ty $$
@@ -779,11 +770,11 @@ checkTypeInType what ty
 checkTypeInType _ _ = return ()
 
 notInKinds :: Outputable ty
-           => RnTyKiWhat
+           => RnTyKiEnv
            -> ty
            -> RnM ()
-notInKinds what ty
-  | isRnKindLevel what
+notInKinds env ty
+  | isRnKindLevel env
   = addErr (text "Illegal kind (even with TypeInType enabled):" <+> ppr ty)
 notInKinds _ _ = return ()
 
@@ -982,38 +973,28 @@ newTyVarNameRn mb_assoc (L loc rdr)
            _                -> newLocalBndrRn (L loc rdr) }
 
 ---------------------
-collectNamedWildCards :: LHsType RdrName -> [Located RdrName]
-collectNamedWildCards hs_ty
-  = nubBy eqLocated $
-    [n | L _ (NamedWildCard n) <- collectWildCards hs_ty ]
-
 collectAnonWildCards :: LHsType Name -> [Name]
-collectAnonWildCards hs_ty
-  = [n | L _ (AnonWildCard (L _ n)) <- collectWildCards hs_ty ]
-
-collectWildCards :: LHsType name -> [Located (HsWildCardInfo name)]
 -- | Extract all wild cards from a type.
-collectWildCards lty = go lty
+collectAnonWildCards lty = go lty
   where
-    go (L loc ty) = case ty of
-      HsAppsTy tys            -> gos (mapMaybe (prefix_types_only . unLoc) tys)
-      HsAppTy ty1 ty2         -> go ty1 `mappend` go ty2
-      HsFunTy ty1 ty2         -> go ty1 `mappend` go ty2
-      HsListTy ty             -> go ty
-      HsPArrTy ty             -> go ty
-      HsTupleTy _ tys         -> gos tys
-      HsOpTy ty1 _ ty2        -> go ty1 `mappend` go ty2
-      HsParTy ty              -> go ty
-      HsIParamTy _ ty         -> go ty
-      HsEqTy ty1 ty2          -> go ty1 `mappend` go ty2
-      HsKindSig ty kind       -> go ty `mappend` go kind
-      HsDocTy ty _            -> go ty
-      HsBangTy _ ty           -> go ty
-      HsRecTy flds            -> gos $ map (cd_fld_type . unLoc) flds
-      HsExplicitListTy _ tys  -> gos tys
-      HsExplicitTupleTy _ tys -> gos tys
-      -- Interesting cases
-      HsWildCardTy wc         -> [L loc wc]
+    go (L _ ty) = case ty of
+      HsWildCardTy (AnonWildCard (L _ wc)) -> [wc]
+      HsAppsTy tys                 -> gos (mapMaybe (prefix_types_only . unLoc) tys)
+      HsAppTy ty1 ty2              -> go ty1 `mappend` go ty2
+      HsFunTy ty1 ty2              -> go ty1 `mappend` go ty2
+      HsListTy ty                  -> go ty
+      HsPArrTy ty                  -> go ty
+      HsTupleTy _ tys              -> gos tys
+      HsOpTy ty1 _ ty2             -> go ty1 `mappend` go ty2
+      HsParTy ty                   -> go ty
+      HsIParamTy _ ty              -> go ty
+      HsEqTy ty1 ty2               -> go ty1 `mappend` go ty2
+      HsKindSig ty kind            -> go ty `mappend` go kind
+      HsDocTy ty _                 -> go ty
+      HsBangTy _ ty                -> go ty
+      HsRecTy flds                 -> gos $ map (cd_fld_type . unLoc) flds
+      HsExplicitListTy _ tys       -> gos tys
+      HsExplicitTupleTy _ tys      -> gos tys
       HsForAllTy { hst_body = ty } -> go ty
       HsQualTy { hst_ctxt = L _ ctxt
                , hst_body = ty }  -> gos ctxt `mappend` go ty
@@ -1040,17 +1021,21 @@ RnNames.getLocalNonValBinders), so we just take the list as an
 argument, build a map and look them up.
 -}
 
-rnConDeclFields :: [FieldLabel] -> HsDocContext -> [LConDeclField RdrName]
+rnConDeclFields :: HsDocContext -> [FieldLabel] -> [LConDeclField RdrName]
                 -> RnM ([LConDeclField Name], FreeVars)
-rnConDeclFields fls doc fields = mapFvRn (rnField fl_env doc) fields
+-- Also called from RnSource
+-- No wildcards can appear in record fields
+rnConDeclFields ctxt fls fields
+   = mapFvRn (rnField fl_env env) fields
   where
+    env    = mkTyKiEnv ctxt TypeLevel RnTypeBody
     fl_env = mkFsEnv [ (flLabel fl, fl) | fl <- fls ]
 
-rnField :: FastStringEnv FieldLabel -> HsDocContext -> LConDeclField RdrName
+rnField :: FastStringEnv FieldLabel -> RnTyKiEnv -> LConDeclField RdrName
         -> RnM (LConDeclField Name, FreeVars)
-rnField fl_env doc (L l (ConDeclField names ty haddock_doc))
+rnField fl_env env (L l (ConDeclField names ty haddock_doc))
   = do { let new_names = map (fmap lookupField) names
-       ; (new_ty, fvs) <- rnLHsType doc ty
+       ; (new_ty, fvs) <- rnLHsTyKi env ty
        ; new_haddock_doc <- rnMbLHsDoc haddock_doc
        ; return (L l (ConDeclField new_names new_ty new_haddock_doc), fvs) }
   where
@@ -1060,25 +1045,6 @@ rnField fl_env doc (L l (ConDeclField names ty haddock_doc))
         lbl = occNameFS $ rdrNameOcc rdr
         fl  = expectJust "rnField" $ lookupFsEnv fl_env lbl
 
-
-{-
-*********************************************************
-*                                                       *
-        Contexts
-*                                                       *
-*********************************************************
--}
-
-rnTyKiContext :: RnTyKiWhat
-              -> HsDocContext -> LHsContext RdrName -> RnM (LHsContext Name, FreeVars)
-rnTyKiContext what doc (L loc cxt)
-  = do { traceRn (text "rncontext" <+> ppr cxt)
-       ; (cxt', fvs) <- mapFvRn (rnLHsPred what doc) cxt
-       ; return (L loc cxt', fvs) }
-
-rnContext :: HsDocContext -> LHsContext RdrName -> RnM (LHsContext Name, FreeVars)
-rnContext = rnTyKiContext (RnConstraint TypeLevel)
-
 {-
 ************************************************************************
 *                                                                      *
@@ -1384,12 +1350,12 @@ badKindSigErr doc (L loc ty)
     hang (ptext (sLit "Illegal kind signature:") <+> quotes (ppr ty))
        2 (ptext (sLit "Perhaps you intended to use KindSignatures"))
 
-dataKindsErr :: RnTyKiWhat -> HsType RdrName -> SDoc
-dataKindsErr what thing
+dataKindsErr :: RnTyKiEnv -> HsType RdrName -> SDoc
+dataKindsErr env thing
   = hang (ptext (sLit "Illegal") <+> pp_what <> colon <+> quotes (ppr thing))
        2 (ptext (sLit "Perhaps you intended to use DataKinds"))
   where
-    pp_what | isRnKindLevel what = ptext (sLit "kind")
+    pp_what | isRnKindLevel env = ptext (sLit "kind")
             | otherwise          = ptext (sLit "type")
 
 inTypeDoc :: HsType RdrName -> SDoc
index ef928e8..a251502 100644 (file)
@@ -618,10 +618,7 @@ equalityT :: TypeQ
 equalityT = return EqualityT
 
 wildCardT :: TypeQ
-wildCardT = return (WildCardT Nothing)
-
-namedWildCardT :: Name -> TypeQ
-namedWildCardT = return . WildCardT . Just
+wildCardT = return WildCardT
 
 {-# DEPRECATED classP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'." #-}
 classP :: Name -> [Q Type] -> Q Pred
index d02ad0a..4db99d8 100644 (file)
@@ -611,7 +611,7 @@ pprParendType PromotedConsT       = text "(':)"
 pprParendType StarT               = char '*'
 pprParendType ConstraintT         = text "Constraint"
 pprParendType (SigT ty k)         = parens (ppr ty <+> text "::" <+> ppr k)
-pprParendType (WildCardT mbName)  = char '_' <> maybe empty ppr mbName
+pprParendType WildCardT           = char '_'
 pprParendType (InfixT x n y)      = parens (ppr x <+> pprName' Infix n <+> ppr y)
 pprParendType t@(UInfixT {})      = parens (pprUInfixT t)
 pprParendType (ParensT t)         = ppr t
index d10fb3c..ea670b3 100644 (file)
@@ -1698,7 +1698,7 @@ data Type = ForallT [TyVarBndr] Cxt Type  -- ^ @forall \<vars\>. \<ctxt\> -> \<t
           | StarT                         -- ^ @*@
           | ConstraintT                   -- ^ @Constraint@
           | LitT TyLit                    -- ^ @0,1,2, etc.@
-          | WildCardT (Maybe Name)        -- ^ @_, _a, etc.@
+          | WildCardT                     -- ^ @_,
       deriving( Show, Eq, Ord, Data, Typeable, Generic )
 
 data TyVarBndr = PlainTV  Name            -- ^ @a@
index 27ddd48..2b86289 100644 (file)
@@ -1,3 +1,3 @@
-[SigD foo_1 (ForallT [PlainTV a_0] [] (AppT (AppT ArrowT (VarT a_0)) (VarT a_0))),FunD foo_1 [Clause [VarP x_2] (NormalB (VarE x_2)) []]]\r
-"[SigD foo_ (AppT (AppT ArrowT (WildCardT (Just _a_))) (WildCardT (Just _a_))),FunD foo_ [Clause [VarP x_] (NormalB (VarE x_)) []]]"\r
-[SigD foo_6 (ForallT [PlainTV _a_5] [] (AppT (AppT ArrowT (VarT _a_5)) (VarT _a_5))),FunD foo_6 [Clause [VarP x_7] (NormalB (VarE x_7)) []]]\r
+[SigD foo_1 (ForallT [PlainTV a_0] [] (AppT (AppT ArrowT (VarT a_0)) (VarT a_0))),FunD foo_1 [Clause [VarP x_2] (NormalB (VarE x_2)) []]]
+"[SigD foo_ (AppT (AppT ArrowT (VarT _a_)) (VarT _a_)),FunD foo_ [Clause [VarP x_] (NormalB (VarE x_)) []]]"
+[SigD foo_6 (ForallT [PlainTV _a_5] [] (AppT (AppT ArrowT (VarT _a_5)) (VarT _a_5))),FunD foo_6 [Clause [VarP x_7] (NormalB (VarE x_7)) []]]
index 9202c18..c877248 100644 (file)
@@ -1,5 +1,5 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE NamedWildCards #-}
+{-# LANGUAGE TemplateHaskell, NamedWildCards #-}
+
 module Splices where
 
 import Language.Haskell.TH
index 21e599d..8a5abb3 100644 (file)
@@ -1,5 +1,5 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE TemplateHaskell, PartialTypeSignatures, NamedWildCards #-}
+
 module SplicesUsed where
 
 import Splices
index 28bb836..c9a00f3 100644 (file)
@@ -1,4 +1,4 @@
-{-# LANGUAGE PartialTypeSignatures, NamedWildCards #-}
+{-# LANGUAGE ConstraintKinds, PartialTypeSignatures, NamedWildCards #-}
 module NamedExtraConstraintsWildcard where
 
 foo :: (Eq a, _a) => a -> a
index 47e9b99..bb1a481 100644 (file)
@@ -1,5 +1,11 @@
-\r
-NamedExtraConstraintsWildcard.hs:4:15: error:\r
-    Named wildcard ‘_a’ not allowed as an extra-contraint\r
-      Use an anonymous wildcard instead\r
-      in the type signature for ‘foo’\r
+
+NamedExtraConstraintsWildcard.hs:5:1: error:
+    • Could not deduce: t0
+      from the context: (Eq a, t)
+        bound by the inferred type for ‘foo’:
+                   (Eq a, t) => a -> a
+        at NamedExtraConstraintsWildcard.hs:5:1-15
+    • In the ambiguity check for the inferred type for ‘foo’
+      To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+      When checking the inferred type
+        foo :: forall a (t :: Constraint). (Eq a, t) => a -> a
index a8d1ea9..fef5e32 160000 (submodule)
@@ -1 +1 @@
-Subproject commit a8d1ea9a6735209746b184001e40da26a83f0509
+Subproject commit fef5e32ca541eb70b22d8e8da611e4a2b797e00c