summaryrefslogtreecommitdiff
path: root/compiler/GHC
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2020-05-26 06:58:20 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-06-10 03:39:12 -0400
commita47e6442bc4be4a33339499d876792ba109e8d32 (patch)
treeb2475e4d0c234c8318635bdfb4a74f49223fb72b /compiler/GHC
parent72c7fe9a1e147dfeaf043f6d591d724a126cce45 (diff)
downloadhaskell-a47e6442bc4be4a33339499d876792ba109e8d32.tar.gz
Always use rnImplicitBndrs to bring implicit tyvars into scope
This implements a first step towards #16762 by changing the renamer to always use `rnImplicitBndrs` to bring implicitly bound type variables into scope. The main change is in `rnFamInstEqn` and `bindHsQTyVars`, which previously used _ad hoc_ methods of binding their implicit tyvars. There are a number of knock-on consequences: * One of the reasons that `rnFamInstEqn` used an _ad hoc_ binding mechanism was to give more precise source locations in `-Wunused-type-patterns` warnings. (See https://gitlab.haskell.org/ghc/ghc/issues/16762#note_273343 for an example of this.) However, these warnings are actually a little _too_ precise, since implicitly bound type variables don't have exact binding sites like explicitly bound type variables do. A similar problem existed for "`Different names for the same type variable`" errors involving implicit tyvars bound by `bindHsQTyVars`. Therefore, we simply accept the less precise (but more accurate) source locations from `rnImplicitBndrs` in `rnFamInstEqn` and `bindHsQTyVars`. See `Note [Source locations for implicitly bound type variables]` in `GHC.Rename.HsType` for the full story. * In order for `rnImplicitBndrs` to work in `rnFamInstEqn`, it needs to be able to look up names from the parent class (in the event that we are renaming an associated type family instance). As a result, `rnImplicitBndrs` now takes an argument of type `Maybe assoc`, which is `Just` in the event that a type family instance is associated with a class. * Previously, GHC kept track of three type synonyms for free type variables in the renamer: `FreeKiTyVars`, `FreeKiTyVarsDups` (which are allowed to contain duplicates), and `FreeKiTyVarsNoDups` (which contain no duplicates). However, making is a distinction between `-Dups` and `-NoDups` is now pointless, as all code that returns `FreeKiTyVars{,Dups,NoDups}` will eventually end up being passed to `rnImplicitBndrs`, which removes duplicates. As a result, I decided to just get rid of `FreeKiTyVarsDups` and `FreeKiTyVarsNoDups`, leaving only `FreeKiTyVars`. * The `bindLRdrNames` and `deleteBys` functions are now dead code, so I took the liberty of removing them.
Diffstat (limited to 'compiler/GHC')
-rw-r--r--compiler/GHC/Data/List/SetOps.hs7
-rw-r--r--compiler/GHC/Hs/Type.hs9
-rw-r--r--compiler/GHC/Rename/HsType.hs225
-rw-r--r--compiler/GHC/Rename/Module.hs129
-rw-r--r--compiler/GHC/Tc/Gen/Splice.hs2
5 files changed, 204 insertions, 168 deletions
diff --git a/compiler/GHC/Data/List/SetOps.hs b/compiler/GHC/Data/List/SetOps.hs
index 2d916e9dd5..15b370582c 100644
--- a/compiler/GHC/Data/List/SetOps.hs
+++ b/compiler/GHC/Data/List/SetOps.hs
@@ -10,7 +10,7 @@
--
-- Avoid using them as much as possible
module GHC.Data.List.SetOps (
- unionLists, minusList, deleteBys,
+ unionLists, minusList,
-- Association lists
Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing,
@@ -39,11 +39,6 @@ getNth :: Outputable a => [a] -> Int -> a
getNth xs n = ASSERT2( xs `lengthExceeds` n, ppr n $$ ppr xs )
xs !! n
-deleteBys :: (a -> a -> Bool) -> [a] -> [a] -> [a]
--- (deleteBys eq xs ys) returns xs-ys, using the given equality function
--- Just like 'Data.List.delete' but with an equality function
-deleteBys eq xs ys = foldl' (flip (L.deleteBy eq)) xs ys
-
{-
************************************************************************
* *
diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index ef935cc59f..9d08a370c9 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -30,7 +30,7 @@ module GHC.Hs.Type (
HsTyLit(..),
HsIPName(..), hsIPNameFS,
HsArg(..), numVisibleArgs,
- LHsTypeArg,
+ LHsTypeArg, lhsTypeArgSrcSpan,
OutputableBndrFlag,
LBangType, BangType,
@@ -1289,6 +1289,13 @@ numVisibleArgs = count is_vis
-- type level equivalent
type LHsTypeArg p = HsArg (LHsType p) (LHsKind p)
+-- | Compute the 'SrcSpan' associated with an 'LHsTypeArg'.
+lhsTypeArgSrcSpan :: LHsTypeArg pass -> SrcSpan
+lhsTypeArgSrcSpan arg = case arg of
+ HsValArg tm -> getLoc tm
+ HsTypeArg at ty -> at `combineSrcSpans` getLoc ty
+ HsArgPar sp -> sp
+
instance (Outputable tm, Outputable ty) => Outputable (HsArg tm ty) where
ppr (HsValArg tm) = ppr tm
ppr (HsTypeArg _ ty) = char '@' <> ppr ty
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index 18f2c9071e..a13b15fe5d 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -24,11 +24,11 @@ module GHC.Rename.HsType (
-- Binding related stuff
bindLHsTyVarBndr, bindLHsTyVarBndrs, WarnUnusedForalls(..),
- rnImplicitBndrs, bindSigTyVarsFV, bindHsQTyVars, bindLRdrNames,
+ rnImplicitBndrs, bindSigTyVarsFV, bindHsQTyVars,
+ FreeKiTyVars,
extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars,
- extractHsTysRdrTyVarsDups,
- extractRdrKindSigVars, extractDataDefnKindVars,
- extractHsTvBndrs, extractHsTyArgRdrKiTyVarsDup,
+ extractHsTysRdrTyVars, extractRdrKindSigVars, extractDataDefnKindVars,
+ extractHsTvBndrs, extractHsTyArgRdrKiTyVars,
forAllOrNothing, nubL
) where
@@ -57,7 +57,6 @@ import GHC.Types.Name.Set
import GHC.Types.FieldLabel
import GHC.Utils.Misc
-import GHC.Data.List.SetOps ( deleteBys )
import GHC.Types.Basic ( compareFixity, funTyFixity, negateFixity
, Fixity(..), FixityDirection(..), LexicalFixity(..)
, TypeOrKind(..) )
@@ -165,14 +164,14 @@ rn_hs_sig_wc_type :: HsSigWcTypeScoping -> HsDocContext -> Maybe SDoc
-> RnM (a, FreeVars)
rn_hs_sig_wc_type scoping ctxt inf_err hs_ty thing_inside
= do { check_inferred_vars ctxt inf_err hs_ty
- ; free_vars <- filterInScopeM (extractHsTyRdrTyVarsDups hs_ty)
+ ; free_vars <- filterInScopeM (extractHsTyRdrTyVars hs_ty)
; (nwc_rdrs', tv_rdrs) <- partition_nwcs free_vars
; let nwc_rdrs = nubL nwc_rdrs'
; implicit_bndrs <- case scoping of
AlwaysBind -> pure tv_rdrs
BindUnlessForall -> forAllOrNothing (isLHsForAllTy hs_ty) tv_rdrs
NeverBind -> pure []
- ; rnImplicitBndrs implicit_bndrs $ \ vars ->
+ ; rnImplicitBndrs Nothing implicit_bndrs $ \ vars ->
do { (wcs, hs_ty', fvs1) <- rnWcBody ctxt nwc_rdrs hs_ty
; (res, fvs2) <- thing_inside wcs vars hs_ty'
; return (res, fvs1 `plusFV` fvs2) } }
@@ -180,7 +179,8 @@ rn_hs_sig_wc_type scoping ctxt inf_err hs_ty thing_inside
rnHsWcType :: HsDocContext -> LHsWcType GhcPs -> RnM (LHsWcType GhcRn, FreeVars)
rnHsWcType ctxt (HsWC { hswc_body = hs_ty })
= do { free_vars <- filterInScopeM (extractHsTyRdrTyVars hs_ty)
- ; (nwc_rdrs, _) <- partition_nwcs free_vars
+ ; (nwc_rdrs', _) <- partition_nwcs free_vars
+ ; let nwc_rdrs = nubL nwc_rdrs'
; (wcs, hs_ty', fvs) <- rnWcBody ctxt nwc_rdrs hs_ty
; let sig_ty' = HsWC { hswc_ext = wcs, hswc_body = hs_ty' }
; return (sig_ty', fvs) }
@@ -330,8 +330,8 @@ rnHsSigType ctx level inf_err (HsIB { hsib_body = hs_ty })
; check_inferred_vars ctx inf_err hs_ty
; vars0 <- forAllOrNothing (isLHsForAllTy hs_ty)
$ filterInScope rdr_env
- $ extractHsTyRdrTyVarsDups hs_ty
- ; rnImplicitBndrs vars0 $ \ vars ->
+ $ extractHsTyRdrTyVars hs_ty
+ ; rnImplicitBndrs Nothing vars0 $ \ vars ->
do { (body', fvs) <- rnLHsTyKi (mkTyKiEnv ctx level RnTypeBody) hs_ty
; return ( HsIB { hsib_ext = vars
@@ -359,9 +359,9 @@ forAllOrNothing :: Bool
-- we do not want to bring 'b' into scope, hence True
-- But f :: a -> b
-- we want to bring both 'a' and 'b' into scope, hence False
- -> FreeKiTyVarsWithDups
+ -> FreeKiTyVars
-- ^ Free vars of the type
- -> RnM FreeKiTyVarsWithDups
+ -> RnM FreeKiTyVars
forAllOrNothing has_outer_forall fvs = case has_outer_forall of
True -> do
traceRn "forAllOrNothing" $ text "has explicit outer forall"
@@ -370,24 +370,50 @@ forAllOrNothing has_outer_forall fvs = case has_outer_forall of
traceRn "forAllOrNothing" $ text "no explicit forall. implicit binders:" <+> ppr fvs
pure fvs
-rnImplicitBndrs :: FreeKiTyVarsWithDups
+rnImplicitBndrs :: Maybe assoc
+ -- ^ @'Just' _@ => an associated type decl
+ -> FreeKiTyVars
-- ^ Surface-syntax free vars that we will implicitly bind.
- -- May have duplicates, which is checked here
+ -- May have duplicates, which are removed here.
-> ([Name] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
-rnImplicitBndrs implicit_vs_with_dups
- thing_inside
+rnImplicitBndrs mb_assoc implicit_vs_with_dups thing_inside
= do { let implicit_vs = nubL implicit_vs_with_dups
; traceRn "rnImplicitBndrs" $
vcat [ ppr implicit_vs_with_dups, ppr implicit_vs ]
+ -- Use the currently set SrcSpan as the new source location for each Name.
+ -- See Note [Source locations for implicitly bound type variables].
; loc <- getSrcSpanM
- ; vars <- mapM (newLocalBndrRn . L loc . unLoc) implicit_vs
+ ; vars <- mapM (newTyVarNameRn mb_assoc . L loc . unLoc) implicit_vs
; bindLocalNamesFV vars $
thing_inside vars }
+{-
+Note [Source locations for implicitly bound type variables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When bringing implicitly bound type variables into scope (in rnImplicitBndrs),
+we do something peculiar: we drop the original SrcSpan attached to each
+variable and replace it with the currently set SrcSpan. Moreover, this new
+SrcSpan is usually /less/ precise than the original one, and that's OK. To see
+why this is done, consider the following example:
+
+ f :: a -> b -> a
+
+Suppose that a warning or error message needs to point to the SrcSpans of the
+binding sites for `a` and `b`. But where /are/ they bound, anyway? Technically,
+they're bound by an unwritten `forall` at the front of the type signature, but
+there is no SrcSpan for that. We could point to the first occurrence of `a` as
+the binding site for `a`, but that would make the first occurrence of `a`
+special. Moreover, we don't want IDEs to confuse binding sites and occurrences.
+
+As a result, we make the `SrcSpan`s for `a` and `b` span the entirety of the
+type signature, since the type signature implicitly carries their binding
+sites. This is less precise, but more accurate.
+-}
+
check_inferred_vars :: HsDocContext
-> Maybe SDoc
-- ^ The error msg if the signature is not allowed to contain
@@ -833,22 +859,11 @@ bindSigTyVarsFV tvs thing_inside
else
bindLocalNamesFV tvs thing_inside }
--- | Simply bring a bunch of RdrNames into scope. No checking for
--- validity, at all. The binding location is taken from the location
--- on each name.
-bindLRdrNames :: [Located RdrName]
- -> ([Name] -> RnM (a, FreeVars))
- -> RnM (a, FreeVars)
-bindLRdrNames rdrs thing_inside
- = do { var_names <- mapM (newTyVarNameRn Nothing) rdrs
- ; bindLocalNamesFV var_names $
- thing_inside var_names }
-
---------------
bindHsQTyVars :: forall a b.
HsDocContext
-> Maybe a -- Just _ => an associated type decl
- -> [Located RdrName] -- Kind variables from scope, no dups
+ -> FreeKiTyVars -- Kind variables from scope
-> LHsQTyVars GhcPs
-> (LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars))
-- The Bool is True <=> all kind variables used in the
@@ -864,17 +879,16 @@ bindHsQTyVars :: forall a b.
-- (b) Bring type variables into scope
--
bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside
- = do { let hs_tv_bndrs = hsQTvExplicit hsq_bndrs
- bndr_kv_occs = extractHsTyVarBndrsKVs hs_tv_bndrs
+ = do { let bndr_kv_occs = extractHsTyVarBndrsKVs hs_tv_bndrs
; let -- See Note [bindHsQTyVars examples] for what
-- all these various things are doing
bndrs, implicit_kvs :: [Located RdrName]
bndrs = map hsLTyVarLocName hs_tv_bndrs
- implicit_kvs = nubL $ filterFreeVarsToBind bndrs $
+ implicit_kvs = filterFreeVarsToBind bndrs $
bndr_kv_occs ++ body_kv_occs
- del = deleteBys eqLocated
- body_remaining = (body_kv_occs `del` bndrs) `del` bndr_kv_occs
+ body_remaining = filterFreeVarsToBind bndr_kv_occs $
+ filterFreeVarsToBind bndrs body_kv_occs
all_bound_on_lhs = null body_remaining
; traceRn "checkMixedVars3" $
@@ -885,17 +899,35 @@ bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside
, text "body_remaining" <+> ppr body_remaining
]
- ; implicit_kv_nms <- mapM (newTyVarNameRn mb_assoc) implicit_kvs
-
- ; bindLocalNamesFV implicit_kv_nms $
+ ; rnImplicitBndrs mb_assoc implicit_kvs $ \ implicit_kv_nms' ->
bindLHsTyVarBndrs doc NoWarnUnusedForalls mb_assoc hs_tv_bndrs $ \ rn_bndrs ->
-- This is the only call site for bindLHsTyVarBndrs where we pass
-- NoWarnUnusedForalls, which suppresses -Wunused-foralls warnings.
-- See Note [Suppress -Wunused-foralls when binding LHsQTyVars].
- do { traceRn "bindHsQTyVars" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs)
+ do { let -- The SrcSpan that rnImplicitBndrs will attach to each Name will
+ -- span the entire declaration to which the LHsQTyVars belongs,
+ -- which will be reflected in warning and error messages. We can
+ -- be a little more precise than that by pointing to the location
+ -- of the LHsQTyVars instead, which is what bndrs_loc
+ -- corresponds to.
+ implicit_kv_nms = map (`setNameLoc` bndrs_loc) implicit_kv_nms'
+
+ ; traceRn "bindHsQTyVars" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs)
; thing_inside (HsQTvs { hsq_ext = implicit_kv_nms
, hsq_explicit = rn_bndrs })
all_bound_on_lhs } }
+ where
+ hs_tv_bndrs = hsQTvExplicit hsq_bndrs
+
+ -- The SrcSpan of the LHsQTyVars. For example, bndrs_loc would be the
+ -- highlighted part in the class below:
+ --
+ -- class C (a :: j) (b :: k) where
+ -- ^^^^^^^^^^^^^^^
+ bndrs_loc = case map getLoc hs_tv_bndrs ++ map getLoc body_kv_occs of
+ [] -> panic "bindHsQTyVars.bndrs_loc"
+ [loc] -> loc
+ (loc:locs) -> loc `combineSrcSpans` last locs
{- Note [bindHsQTyVars examples]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -912,12 +944,12 @@ Then:
body_kv_occs = [k2,k1], kind variables free in the
result kind signature
- implicit_kvs = [k1,k2], kind variables free in kind signatures
- of hs_tv_bndrs, and not bound by bndrs
+ implicit_kvs = [k1,k2,k1], kind variables free in kind signatures
+ of hs_tv_bndrs, and not bound by bndrs
* We want to quantify add implicit bindings for implicit_kvs
-* If implicit_body_kvs is non-empty, then there is a kind variable
+* If body_kv_occs is non-empty, then there is a kind variable
mentioned in the kind signature that is not bound "on the left".
That's one of the rules for a CUSK, so we pass that info on
as the second argument to thing_inside.
@@ -925,6 +957,9 @@ Then:
* Order is not important in these lists. All we are doing is
bring Names into scope.
+* bndr_kv_occs, body_kv_occs, and implicit_kvs can contain duplicates. All
+ duplicate occurrences are removed when we bind them with rnImplicitBndrs.
+
Finally, you may wonder why filterFreeVarsToBind removes in-scope variables
from bndr/body_kv_occs. How can anything be in scope? Answer:
HsQTyVars is /also/ used (slightly oddly) for Haskell-98 syntax
@@ -1076,14 +1111,15 @@ bindLHsTyVarBndr doc mb_assoc (L loc (KindedTyVar x fl lrdr@(L lv _) kind))
$ thing_inside (L loc (KindedTyVar x fl (L lv tv_nm) kind'))
; return (b, fvs1 `plusFV` fvs2) }
-newTyVarNameRn :: Maybe a -> Located RdrName -> RnM Name
-newTyVarNameRn mb_assoc (L loc rdr)
+newTyVarNameRn :: Maybe a -- associated class
+ -> Located RdrName -> RnM Name
+newTyVarNameRn mb_assoc lrdr@(L _ rdr)
= do { rdr_env <- getLocalRdrEnv
; case (mb_assoc, lookupLocalRdrEnv rdr_env rdr) of
(Just _, Just n) -> return n
-- Use the same Name as the parent class decl
- _ -> newLocalBndrRn (L loc rdr) }
+ _ -> newLocalBndrRn lrdr }
{-
*********************************************************
* *
@@ -1538,7 +1574,10 @@ To do that, we need to walk over a type and find its free type/kind variables.
We preserve the left-to-right order of each variable occurrence.
See Note [Ordering of implicit variables].
-Clients of this code can remove duplicates with nubL.
+It is common for lists of free type variables to contain duplicates. For
+example, in `f :: a -> a`, the free type variable list is [a, a]. When these
+implicitly bound variables are brought into scope (with rnImplicitBndrs),
+duplicates are removed with nubL.
Note [Ordering of implicit variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1567,9 +1606,8 @@ the a in the code. Thus, GHC does ScopedSort on the variables.
See Note [ScopedSort] in GHC.Core.Type.
Implicitly bound variables are collected by any function which returns a
-FreeKiTyVars, FreeKiTyVarsWithDups, or FreeKiTyVarsNoDups, which notably
-includes the `extract-` family of functions (extractHsTysRdrTyVarsDups,
-extractHsTyVarBndrsKVs, etc.).
+FreeKiTyVars, which notably includes the `extract-` family of functions
+(extractHsTysRdrTyVars, extractHsTyVarBndrsKVs, etc.).
These functions thus promise to keep left-to-right ordering.
Note [Implicit quantification in type synonyms]
@@ -1655,18 +1693,13 @@ type checking. While viable, this would mean we'd end up accepting this:
-}
+-- A list of free type/kind variables, which can contain duplicates.
-- See Note [Kind and type-variable binders]
-- These lists are guaranteed to preserve left-to-right ordering of
-- the types the variables were extracted from. See also
-- Note [Ordering of implicit variables].
type FreeKiTyVars = [Located RdrName]
--- | A 'FreeKiTyVars' list that is allowed to have duplicate variables.
-type FreeKiTyVarsWithDups = FreeKiTyVars
-
--- | A 'FreeKiTyVars' list that contains no duplicate variables.
-type FreeKiTyVarsNoDups = FreeKiTyVars
-
-- | Filter out any type and kind variables that are already in scope in the
-- the supplied LocalRdrEnv. Note that this includes named wildcards, which
-- look like perfectly ordinary type variables at this point.
@@ -1684,46 +1717,32 @@ filterInScopeM vars
inScope :: LocalRdrEnv -> RdrName -> Bool
inScope rdr_env rdr = rdr `elemLocalRdrEnv` rdr_env
-extract_tyarg :: LHsTypeArg GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
+extract_tyarg :: LHsTypeArg GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_tyarg (HsValArg ty) acc = extract_lty ty acc
extract_tyarg (HsTypeArg _ ki) acc = extract_lty ki acc
extract_tyarg (HsArgPar _) acc = acc
-extract_tyargs :: [LHsTypeArg GhcPs] -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
+extract_tyargs :: [LHsTypeArg GhcPs] -> FreeKiTyVars -> FreeKiTyVars
extract_tyargs args acc = foldr extract_tyarg acc args
-extractHsTyArgRdrKiTyVarsDup :: [LHsTypeArg GhcPs] -> FreeKiTyVarsWithDups
-extractHsTyArgRdrKiTyVarsDup args
+extractHsTyArgRdrKiTyVars :: [LHsTypeArg GhcPs] -> FreeKiTyVars
+extractHsTyArgRdrKiTyVars args
= extract_tyargs args []
-- | 'extractHsTyRdrTyVars' finds the type/kind variables
-- of a HsType/HsKind.
-- It's used when making the @forall@s explicit.
--- When the same name occurs multiple times in the types, only the first
--- occurrence is returned.
-- See Note [Kind and type-variable binders]
-extractHsTyRdrTyVars :: LHsType GhcPs -> FreeKiTyVarsNoDups
-extractHsTyRdrTyVars ty
- = nubL (extractHsTyRdrTyVarsDups ty)
-
--- | 'extractHsTyRdrTyVarsDups' finds the type/kind variables
--- of a HsType/HsKind.
--- It's used when making the @forall@s explicit.
--- When the same name occurs multiple times in the types, all occurrences
--- are returned.
-extractHsTyRdrTyVarsDups :: LHsType GhcPs -> FreeKiTyVarsWithDups
-extractHsTyRdrTyVarsDups ty
- = extract_lty ty []
+extractHsTyRdrTyVars :: LHsType GhcPs -> FreeKiTyVars
+extractHsTyRdrTyVars ty = extract_lty ty []
-- | Extracts the free type/kind variables from the kind signature of a HsType.
-- This is used to implicitly quantify over @k@ in @type T = Nothing :: Maybe k@.
--- When the same name occurs multiple times in the type, only the first
--- occurrence is returned, and the left-to-right order of variables is
--- preserved.
+-- The left-to-right order of variables is preserved.
-- See Note [Kind and type-variable binders] and
-- Note [Ordering of implicit variables] and
-- Note [Implicit quantification in type synonyms].
-extractHsTyRdrTyVarsKindVars :: LHsType GhcPs -> FreeKiTyVarsNoDups
+extractHsTyRdrTyVarsKindVars :: LHsType GhcPs -> FreeKiTyVars
extractHsTyRdrTyVarsKindVars (L _ ty) =
case ty of
HsParTy _ ty -> extractHsTyRdrTyVarsKindVars ty
@@ -1733,51 +1752,45 @@ extractHsTyRdrTyVarsKindVars (L _ ty) =
-- | Extracts free type and kind variables from types in a list.
-- When the same name occurs multiple times in the types, all occurrences
-- are returned.
-extractHsTysRdrTyVarsDups :: [LHsType GhcPs] -> FreeKiTyVarsWithDups
-extractHsTysRdrTyVarsDups tys
- = extract_ltys tys []
+extractHsTysRdrTyVars :: [LHsType GhcPs] -> FreeKiTyVars
+extractHsTysRdrTyVars tys = extract_ltys tys []
-- Returns the free kind variables of any explicitly-kinded binders, returning
-- variable occurrences in left-to-right order.
-- See Note [Ordering of implicit variables].
-- NB: Does /not/ delete the binders themselves.
--- However duplicates are removed
-- E.g. given [k1, a:k1, b:k2]
-- the function returns [k1,k2], even though k1 is bound here
-extractHsTyVarBndrsKVs :: [LHsTyVarBndr flag GhcPs] -> FreeKiTyVarsNoDups
-extractHsTyVarBndrsKVs tv_bndrs
- = nubL (extract_hs_tv_bndrs_kvs tv_bndrs)
+extractHsTyVarBndrsKVs :: [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars
+extractHsTyVarBndrsKVs tv_bndrs = extract_hs_tv_bndrs_kvs tv_bndrs
-- Returns the free kind variables in a type family result signature, returning
-- variable occurrences in left-to-right order.
-- See Note [Ordering of implicit variables].
-extractRdrKindSigVars :: LFamilyResultSig GhcPs -> [Located RdrName]
+extractRdrKindSigVars :: LFamilyResultSig GhcPs -> FreeKiTyVars
extractRdrKindSigVars (L _ resultSig) = case resultSig of
KindSig _ k -> extractHsTyRdrTyVars k
TyVarSig _ (L _ (KindedTyVar _ _ _ k)) -> extractHsTyRdrTyVars k
_ -> []
-- | Get type/kind variables mentioned in the kind signature, preserving
--- left-to-right order and without duplicates:
+-- left-to-right order:
--
-- * data T a (b :: k1) :: k2 -> k1 -> k2 -> Type -- result: [k2,k1]
-- * data T a (b :: k1) -- result: []
--
-- See Note [Ordering of implicit variables].
-extractDataDefnKindVars :: HsDataDefn GhcPs -> FreeKiTyVarsNoDups
+extractDataDefnKindVars :: HsDataDefn GhcPs -> FreeKiTyVars
extractDataDefnKindVars (HsDataDefn { dd_kindSig = ksig })
= maybe [] extractHsTyRdrTyVars ksig
-extract_lctxt :: LHsContext GhcPs
- -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
+extract_lctxt :: LHsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lctxt ctxt = extract_ltys (unLoc ctxt)
-extract_ltys :: [LHsType GhcPs]
- -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
+extract_ltys :: [LHsType GhcPs] -> FreeKiTyVars -> FreeKiTyVars
extract_ltys tys acc = foldr extract_lty acc tys
-extract_lty :: LHsType GhcPs
- -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
+extract_lty :: LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty (L _ ty) acc
= case ty of
HsTyVar _ _ ltv -> extract_tv ltv acc
@@ -1818,15 +1831,15 @@ extract_lty (L _ ty) acc
HsWildCardTy {} -> acc
extractHsTvBndrs :: [LHsTyVarBndr flag GhcPs]
- -> FreeKiTyVarsWithDups -- Free in body
- -> FreeKiTyVarsWithDups -- Free in result
+ -> FreeKiTyVars -- Free in body
+ -> FreeKiTyVars -- Free in result
extractHsTvBndrs tv_bndrs body_fvs
= extract_hs_tv_bndrs tv_bndrs [] body_fvs
extract_hs_tv_bndrs :: [LHsTyVarBndr flag GhcPs]
- -> FreeKiTyVarsWithDups -- Accumulator
- -> FreeKiTyVarsWithDups -- Free in body
- -> FreeKiTyVarsWithDups
+ -> FreeKiTyVars -- Accumulator
+ -> FreeKiTyVars -- Free in body
+ -> FreeKiTyVars
-- In (forall (a :: Maybe e). a -> b) we have
-- 'a' is bound by the forall
-- 'b' is a free type variable
@@ -1841,24 +1854,28 @@ extract_hs_tv_bndrs tv_bndrs acc_vars body_vars = new_vars ++ acc_vars
bndr_vars = extract_hs_tv_bndrs_kvs tv_bndrs
tv_bndr_rdrs = map hsLTyVarLocName tv_bndrs
-extract_hs_tv_bndrs_kvs :: [LHsTyVarBndr flag GhcPs] -> FreeKiTyVarsWithDups
+extract_hs_tv_bndrs_kvs :: [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars
-- Returns the free kind variables of any explicitly-kinded binders, returning
-- variable occurrences in left-to-right order.
-- See Note [Ordering of implicit variables].
-- NB: Does /not/ delete the binders themselves.
--- Duplicates are /not/ removed
-- E.g. given [k1, a:k1, b:k2]
-- the function returns [k1,k2], even though k1 is bound here
extract_hs_tv_bndrs_kvs tv_bndrs =
foldr extract_lty []
[k | L _ (KindedTyVar _ _ _ k) <- tv_bndrs]
-extract_tv :: Located RdrName
- -> [Located RdrName] -> [Located RdrName]
+extract_tv :: Located RdrName -> FreeKiTyVars -> FreeKiTyVars
extract_tv tv acc =
if isRdrTyVar (unLoc tv) then tv:acc else acc
--- Deletes duplicates in a list of Located things.
+-- Deletes duplicates in a list of Located things. This is used to:
+--
+-- * Delete duplicate occurrences of implicitly bound type/kind variables when
+-- bringing them into scope (in rnImplicitBndrs).
+--
+-- * Delete duplicate occurrences of named wildcards (in rn_hs_sig_wc_type and
+-- rnHsWcType).
--
-- Importantly, this function is stable with respect to the original ordering
-- of things in the list. This is important, as it is a property that GHC
@@ -1872,9 +1889,9 @@ nubL = nubBy eqLocated
-- already in scope, or are explicitly bound in the binder.
filterFreeVarsToBind :: FreeKiTyVars
-- ^ Explicitly bound here
- -> FreeKiTyVarsWithDups
+ -> FreeKiTyVars
-- ^ Potential implicit binders
- -> FreeKiTyVarsWithDups
+ -> FreeKiTyVars
-- ^ Final implicit binders
filterFreeVarsToBind bndrs = filterOut is_in_scope
-- Make sure to list the binder kvs before the body kvs, as mandated by
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 0a355b01ee..deee12a726 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -664,7 +664,7 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
rnFamInstEqn :: HsDocContext
-> AssocTyFamInfo
- -> [Located RdrName]
+ -> FreeKiTyVars
-- ^ Kind variables from the equation's RHS to be implicitly bound
-- if no explicit forall.
-> FamInstEqn GhcPs rhs
@@ -676,16 +676,7 @@ rnFamInstEqn doc atfi rhs_kvars
, feqn_pats = pats
, feqn_fixity = fixity
, feqn_rhs = payload }}) rn_payload
- = do { let mb_cls = case atfi of
- NonAssocTyFamEqn -> Nothing
- AssocTyFamDeflt cls -> Just cls
- AssocTyFamInst cls _ -> Just cls
- ; tycon' <- lookupFamInstName mb_cls tycon
- ; let pat_kity_vars_with_dups = extractHsTyArgRdrKiTyVarsDup pats
- -- Use the "...Dups" form because it's needed
- -- below to report unused binder on the LHS
-
- ; let bndrs = fromMaybe [] mb_bndrs
+ = do { tycon' <- lookupFamInstName mb_cls tycon
-- all_imp_vars represent the implicitly bound type variables. This is
-- empty if we have an explicit `forall` (see
@@ -713,48 +704,45 @@ rnFamInstEqn doc atfi rhs_kvars
-- No need to filter out explicit binders (the 'mb_bndrs = Just
-- explicit_bndrs' case) because there must be none if we're going
-- to implicitly bind anything, per the previous comment.
- nubL $ pat_kity_vars_with_dups ++ rhs_kvars
- ; all_imp_var_names <- mapM (newTyVarNameRn mb_cls) all_imp_vars
-
- -- All the free vars of the family patterns
- -- with a sensible binding location
- ; ((bndrs', pats', payload'), fvs)
- <- bindLocalNamesFV all_imp_var_names $
- bindLHsTyVarBndrs doc WarnUnusedForalls
- Nothing bndrs $ \bndrs' ->
- -- Note: If we pass mb_cls instead of Nothing here,
- -- bindLHsTyVarBndrs will use class variables for any names
- -- the user meant to bring in scope here. This is an explicit
- -- forall, so we want fresh names, not class variables.
- -- Thus: always pass Nothing
- do { (pats', pat_fvs) <- rnLHsTypeArgs (FamPatCtx tycon) pats
- ; (payload', rhs_fvs) <- rn_payload doc payload
-
- -- Report unused binders on the LHS
- -- See Note [Unused type variables in family instances]
- ; let groups :: [NonEmpty (Located RdrName)]
- groups = equivClasses cmpLocated $
- pat_kity_vars_with_dups
- ; nms_dups <- mapM (lookupOccRn . unLoc) $
- [ tv | (tv :| (_:_)) <- groups ]
- -- Add to the used variables
- -- a) any variables that appear *more than once* on the LHS
- -- e.g. F a Int a = Bool
- -- b) for associated instances, the variables
- -- of the instance decl. See
- -- Note [Unused type variables in family instances]
- ; let nms_used = extendNameSetList rhs_fvs $
- inst_tvs ++ nms_dups
- inst_tvs = case atfi of
- NonAssocTyFamEqn -> []
- AssocTyFamDeflt _ -> []
- AssocTyFamInst _ inst_tvs -> inst_tvs
- all_nms = all_imp_var_names ++ hsLTyVarNames bndrs'
- ; warnUnusedTypePatterns all_nms nms_used
-
- ; return ((bndrs', pats', payload'), rhs_fvs `plusFV` pat_fvs) }
-
- ; let all_fvs = fvs `addOneFV` unLoc tycon'
+ pat_kity_vars_with_dups ++ rhs_kvars
+
+ ; rnImplicitBndrs mb_cls all_imp_vars $ \all_imp_var_names' ->
+ bindLHsTyVarBndrs doc WarnUnusedForalls
+ Nothing (fromMaybe [] mb_bndrs) $ \bndrs' ->
+ -- Note: If we pass mb_cls instead of Nothing here,
+ -- bindLHsTyVarBndrs will use class variables for any names
+ -- the user meant to bring in scope here. This is an explicit
+ -- forall, so we want fresh names, not class variables.
+ -- Thus: always pass Nothing
+ do { (pats', pat_fvs) <- rnLHsTypeArgs (FamPatCtx tycon) pats
+ ; (payload', rhs_fvs) <- rn_payload doc payload
+
+ -- Report unused binders on the LHS
+ -- See Note [Unused type variables in family instances]
+ ; let -- The SrcSpan that rnImplicitBndrs will attach to each Name will
+ -- span the entire type family instance, which will be reflected in
+ -- -Wunused-type-patterns warnings. We can be a little more precise
+ -- than that by pointing to the LHS of the instance instead, which
+ -- is what lhs_loc corresponds to.
+ all_imp_var_names = map (`setNameLoc` lhs_loc) all_imp_var_names'
+
+ groups :: [NonEmpty (Located RdrName)]
+ groups = equivClasses cmpLocated $
+ pat_kity_vars_with_dups
+ ; nms_dups <- mapM (lookupOccRn . unLoc) $
+ [ tv | (tv :| (_:_)) <- groups ]
+ -- Add to the used variables
+ -- a) any variables that appear *more than once* on the LHS
+ -- e.g. F a Int a = Bool
+ -- b) for associated instances, the variables
+ -- of the instance decl. See
+ -- Note [Unused type variables in family instances]
+ ; let nms_used = extendNameSetList rhs_fvs $
+ inst_tvs ++ nms_dups
+ all_nms = all_imp_var_names ++ hsLTyVarNames bndrs'
+ ; warnUnusedTypePatterns all_nms nms_used
+
+ ; let all_fvs = (rhs_fvs `plusFV` pat_fvs) `addOneFV` unLoc tycon'
-- type instance => use, hence addOneFV
; return (HsIB { hsib_ext = all_imp_var_names -- Note [Wildcards in family instances]
@@ -765,7 +753,36 @@ rnFamInstEqn doc atfi rhs_kvars
, feqn_pats = pats'
, feqn_fixity = fixity
, feqn_rhs = payload' } },
- all_fvs) }
+ all_fvs) } }
+ where
+ -- The parent class, if we are dealing with an associated type family
+ -- instance.
+ mb_cls = case atfi of
+ NonAssocTyFamEqn -> Nothing
+ AssocTyFamDeflt cls -> Just cls
+ AssocTyFamInst cls _ -> Just cls
+
+ -- The type variables from the instance head, if we are dealing with an
+ -- associated type family instance.
+ inst_tvs = case atfi of
+ NonAssocTyFamEqn -> []
+ AssocTyFamDeflt _ -> []
+ AssocTyFamInst _ inst_tvs -> inst_tvs
+
+ pat_kity_vars_with_dups = extractHsTyArgRdrKiTyVars pats
+ -- It is crucial that extractHsTyArgRdrKiTyVars return
+ -- duplicate occurrences, since they're needed to help
+ -- determine unused binders on the LHS.
+
+ -- The SrcSpan of the LHS of the instance. For example, lhs_loc would be
+ -- the highlighted part in the example below:
+ --
+ -- type instance F a b c = Either a b
+ -- ^^^^^
+ lhs_loc = case map lhsTypeArgSrcSpan pats ++ map getLoc rhs_kvars of
+ [] -> panic "rnFamInstEqn.lhs_loc"
+ [loc] -> loc
+ (loc:locs) -> loc `combineSrcSpans` last locs
rnTyFamInstDecl :: AssocTyFamInfo
-> TyFamInstDecl GhcPs
@@ -2116,11 +2133,11 @@ rnConDecl decl@(ConDeclGADT { con_names = names
-- See #14808.
; implicit_bndrs <- forAllOrNothing explicit_forall
$ extractHsTvBndrs explicit_tkvs
- $ extractHsTysRdrTyVarsDups (theta ++ arg_tys ++ [res_ty])
+ $ extractHsTysRdrTyVars (theta ++ arg_tys ++ [res_ty])
; let ctxt = ConDeclCtx new_names
- ; rnImplicitBndrs implicit_bndrs $ \ implicit_tkvs ->
+ ; rnImplicitBndrs Nothing implicit_bndrs $ \ implicit_tkvs ->
bindLHsTyVarBndrs ctxt WarnUnusedForalls
Nothing explicit_tkvs $ \ explicit_tkvs ->
do { (new_cxt, fvs1) <- rnMbContext ctxt mcxt
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index f1233c55ed..3a4d0de24f 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -1431,7 +1431,7 @@ reifyInstances th_nm th_tys
-- must error before proceeding to typecheck the
-- renamed type, as that will result in GHC
-- internal errors (#13837).
- bindLRdrNames tv_rdrs $ \ tv_names ->
+ rnImplicitBndrs Nothing tv_rdrs $ \ tv_names ->
do { (rn_ty, fvs) <- rnLHsType doc rdr_ty
; return ((tv_names, rn_ty), fvs) }
; (_tvs, ty)