Commit d47324ce authored by Ryan Scott's avatar Ryan Scott Committed by Marge Bot

Don't mark closed type family equations as occurrences

Previously, `rnFamInstEqn` would mark the name of the type/data
family used in an equation as an occurrence, regardless of what sort
of family it is. Most of the time, this is the correct thing to do.
The exception is closed type families, whose equations constitute its
definition and therefore should not be marked as occurrences.
Overzealously counting the equations of a closed type family as
occurrences can cause certain warnings to not be emitted, as observed
in #18470.  See `Note [Type family equations and occurrences]` in
`GHC.Rename.Module` for the full story.

This fixes #18470 with a little bit of extra-casing in
`rnFamInstEqn`. To accomplish this, I added an extra
`ClosedTyFamInfo` field to the `NonAssocTyFamEqn` constructor of
`AssocTyFamInfo` and refactored the relevant call sites accordingly
so that this information is propagated to `rnFamInstEqn`.

While I was in town, I moved `wrongTyFamName`, which checks that the
name of a closed type family matches the name in an equation for that
family, from the renamer to the typechecker to avoid the need for an
`ASSERT`. As an added bonus, this lets us simplify the details of
`ClosedTyFamInfo` a bit.
parent 01c948eb
Pipeline #22813 passed with stages
in 648 minutes and 23 seconds
......@@ -424,11 +424,11 @@ patchCCallTarget unit callTarget =
rnSrcInstDecl :: InstDecl GhcPs -> RnM (InstDecl GhcRn, FreeVars)
rnSrcInstDecl (TyFamInstD { tfid_inst = tfi })
= do { (tfi', fvs) <- rnTyFamInstDecl NonAssocTyFamEqn tfi
= do { (tfi', fvs) <- rnTyFamInstDecl (NonAssocTyFamEqn NotClosedTyFam) tfi
; return (TyFamInstD { tfid_ext = noExtField, tfid_inst = tfi' }, fvs) }
rnSrcInstDecl (DataFamInstD { dfid_inst = dfi })
= do { (dfi', fvs) <- rnDataFamInstDecl NonAssocTyFamEqn dfi
= do { (dfi', fvs) <- rnDataFamInstDecl (NonAssocTyFamEqn NotClosedTyFam) dfi
; return (DataFamInstD { dfid_ext = noExtField, dfid_inst = dfi' }, fvs) }
rnSrcInstDecl (ClsInstD { cid_inst = cid })
......@@ -763,8 +763,12 @@ rnFamInstEqn doc atfi rhs_kvars
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
; let eqn_fvs = rhs_fvs `plusFV` pat_fvs
-- See Note [Type family equations and occurrences]
all_fvs = case atfi of
NonAssocTyFamEqn ClosedTyFam
-> eqn_fvs
_ -> eqn_fvs `addOneFV` unLoc tycon'
; return (HsIB { hsib_ext = all_imp_var_names -- Note [Wildcards in family instances]
, hsib_body
......@@ -779,14 +783,14 @@ rnFamInstEqn doc atfi rhs_kvars
-- The parent class, if we are dealing with an associated type family
-- instance.
mb_cls = case atfi of
NonAssocTyFamEqn -> Nothing
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 -> []
NonAssocTyFamEqn _ -> []
AssocTyFamDeflt _ -> []
AssocTyFamInst _ inst_tvs -> inst_tvs
......@@ -809,48 +813,62 @@ rnTyFamInstDecl :: AssocTyFamInfo
-> TyFamInstDecl GhcPs
-> RnM (TyFamInstDecl GhcRn, FreeVars)
rnTyFamInstDecl atfi (TyFamInstDecl { tfid_eqn = eqn })
= do { (eqn', fvs) <- rnTyFamInstEqn atfi NotClosedTyFam eqn
= do { (eqn', fvs) <- rnTyFamInstEqn atfi eqn
; return (TyFamInstDecl { tfid_eqn = eqn' }, fvs) }
-- | Tracks whether we are renaming:
--
-- 1. A type family equation that is not associated
-- with a parent type class ('NonAssocTyFamEqn')
-- with a parent type class ('NonAssocTyFamEqn'). Examples:
--
-- 2. An associated type family default declaration ('AssocTyFamDeflt')
-- @
-- type family F a
-- type instance F Int = Bool -- NonAssocTyFamEqn NotClosed
--
-- 3. An associated type family instance declaration ('AssocTyFamInst')
-- type family G a where
-- G Int = Bool -- NonAssocTyFamEqn Closed
-- @
--
-- 2. An associated type family default declaration ('AssocTyFamDeflt').
-- Example:
--
-- @
-- class C a where
-- type A a
-- type instance A a = a -> a -- AssocTyFamDeflt C
-- @
--
-- 3. An associated type family instance declaration ('AssocTyFamInst').
-- Example:
--
-- @
-- instance C a => C [a] where
-- type A [a] = Bool -- AssocTyFamInst C [a]
-- @
data AssocTyFamInfo
= NonAssocTyFamEqn
| AssocTyFamDeflt Name -- Name of the parent class
| AssocTyFamInst Name -- Name of the parent class
[Name] -- Names of the tyvars of the parent instance decl
ClosedTyFamInfo -- Is this a closed type family?
| AssocTyFamDeflt
Name -- Name of the parent class
| AssocTyFamInst
Name -- Name of the parent class
[Name] -- Names of the tyvars of the parent instance decl
-- | Tracks whether we are renaming an equation in a closed type family
-- equation ('ClosedTyFam') or not ('NotClosedTyFam').
data ClosedTyFamInfo
= NotClosedTyFam
| ClosedTyFam (Located RdrName) Name
-- The names (RdrName and Name) of the closed type family
| ClosedTyFam
rnTyFamInstEqn :: AssocTyFamInfo
-> ClosedTyFamInfo
-> TyFamInstEqn GhcPs
-> RnM (TyFamInstEqn GhcRn, FreeVars)
rnTyFamInstEqn atfi ctf_info
rnTyFamInstEqn atfi
eqn@(HsIB { hsib_body = FamEqn { feqn_tycon = tycon
, feqn_rhs = rhs }})
= do { let rhs_kvs = extractHsTyRdrTyVarsKindVars rhs
; (eqn'@(HsIB { hsib_body =
FamEqn { feqn_tycon = L _ tycon' }}), fvs)
<- rnFamInstEqn (TySynCtx tycon) atfi rhs_kvs eqn rnTySyn
; case ctf_info of
NotClosedTyFam -> pure ()
ClosedTyFam fam_rdr_name fam_name ->
checkTc (fam_name == tycon') $
withHsDocContext (TyFamilyCtx fam_rdr_name) $
wrongTyFamName fam_name tycon'
; pure (eqn', fvs) }
= rnFamInstEqn (TySynCtx tycon) atfi rhs_kvs eqn rnTySyn
where
rhs_kvs = extractHsTyRdrTyVarsKindVars rhs
rnTyFamDefltDecl :: Name
-> TyFamDefltDecl GhcPs
......@@ -998,6 +1016,51 @@ was previously bound by the `instance C (Maybe a)` part. (see #16116).
In each case, the function which detects improperly bound variables on the RHS
is GHC.Tc.Validity.checkValidFamPats.
Note [Type family equations and occurrences]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In most data/type family equations, the type family name used in the equation
is treated as an occurrence. For example:
module A where
type family F a
module B () where
import B (F)
type instance F Int = Bool
We do not want to warn about `F` being unused in the module `B`, as the
instance constitutes a use site for `F`. The exception to this rule is closed
type families, whose equations constitute a definition, not occurrences. For
example:
module C () where
type family CF a where
CF Char = Float
Here, we /do/ want to warn that `CF` is unused in the module `C`, as it is
defined but not used (#18470).
GHC accomplishes this in rnFamInstEqn when determining the set of free
variables to return at the end. If renaming a data family or open type family
equation, we add the name of the type family constructor to the set of returned
free variables to ensure that the name is marked as an occurrence. If renaming
a closed type family equation, we avoid adding the type family constructor name
to the free variables. This is quite simple, but it is not a perfect solution.
Consider this example:
module X () where
type family F a where
F Int = Bool
F Double = F Int
At present, GHC will treat any use of a type family constructor on the RHS of a
type family equation as an occurrence. Since `F` is used on the RHS of the
second equation of `F`, it is treated as an occurrence, causing `F` not to be
warned about. This is not ideal, since `F` isn't exported—it really /should/
cause a warning to be emitted. There is some discussion in #10089/#12920 about
how this limitation might be overcome, but until then, we stick to the
simplistic solution above, as it fixes the egregious bug in #18470.
-}
......@@ -1948,7 +2011,7 @@ rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars
; injectivity' <- traverse (rnInjectivityAnn tyvars' res_sig')
injectivity
; return ( (tyvars', res_sig', injectivity') , fv_kind ) }
; (info', fv2) <- rn_info tycon' info
; (info', fv2) <- rn_info info
; return (FamilyDecl { fdExt = noExtField
, fdLName = tycon', fdTyVars = tyvars'
, fdFixity = fixity
......@@ -1960,18 +2023,16 @@ rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars
kvs = extractRdrKindSigVars res_sig
----------------------
rn_info :: Located Name
-> FamilyInfo GhcPs -> RnM (FamilyInfo GhcRn, FreeVars)
rn_info (L _ fam_name) (ClosedTypeFamily (Just eqns))
rn_info :: FamilyInfo GhcPs -> RnM (FamilyInfo GhcRn, FreeVars)
rn_info (ClosedTypeFamily (Just eqns))
= do { (eqns', fvs)
<- rnList (rnTyFamInstEqn NonAssocTyFamEqn (ClosedTyFam tycon fam_name))
<- rnList (rnTyFamInstEqn (NonAssocTyFamEqn ClosedTyFam)) eqns
-- no class context
eqns
; return (ClosedTypeFamily (Just eqns'), fvs) }
rn_info _ (ClosedTypeFamily Nothing)
rn_info (ClosedTypeFamily Nothing)
= return (ClosedTypeFamily Nothing, emptyFVs)
rn_info _ OpenTypeFamily = return (OpenTypeFamily, emptyFVs)
rn_info _ DataFamily = return (DataFamily, emptyFVs)
rn_info OpenTypeFamily = return (OpenTypeFamily, emptyFVs)
rn_info DataFamily = return (DataFamily, emptyFVs)
rnFamResultSig :: HsDocContext
-> FamilyResultSig GhcPs
......@@ -2115,13 +2176,6 @@ are no data constructors we allow h98_style = True
* *
***************************************************** -}
---------------
wrongTyFamName :: Name -> Name -> SDoc
wrongTyFamName fam_tc_name eqn_tc_name
= hang (text "Mismatched type name in type family instance.")
2 (vcat [ text "Expected:" <+> ppr fam_tc_name
, text " Actual:" <+> ppr eqn_tc_name ])
-----------------
rnConDecls :: [LConDecl GhcPs] -> RnM ([LConDecl GhcRn], FreeVars)
rnConDecls = mapFvRn (wrapLocFstM rnConDecl)
......
......@@ -67,8 +67,8 @@ data AssocInstInfo
}
isNotAssociated :: AssocInstInfo -> Bool
isNotAssociated NotAssociated = True
isNotAssociated (InClsInst {}) = False
isNotAssociated (NotAssociated {}) = True
isNotAssociated (InClsInst {}) = False
{- *******************************************************************
......
......@@ -2833,8 +2833,17 @@ kcTyFamInstEqn tc_fam_tc
, text "feqn_pats =" <+> ppr hs_pats ])
-- this check reports an arity error instead of a kind error; easier for user
; let vis_pats = numVisibleArgs hs_pats
-- First, check if we're dealing with a closed type family equation, and
-- if so, ensure that each equation's type constructor is for the right
-- type family. E.g. barf on
-- type family F a where { G Int = Bool }
; checkTc (tc_fam_tc_name == eqn_tc_name) $
wrongTyFamName tc_fam_tc_name eqn_tc_name
; checkTc (vis_pats == vis_arity) $
wrongNumberOfParmsErr vis_arity
; discardResult $
bindImplicitTKBndrs_Q_Tv imp_vars $
bindExplicitTKBndrs_Q_Tv AnyKind (mb_expl_bndrs `orElse` []) $
......@@ -2848,7 +2857,7 @@ kcTyFamInstEqn tc_fam_tc
}
where
vis_arity = length (tyConVisibleTyVars tc_fam_tc)
tc_fam_tc_name = getName tc_fam_tc
--------------------------
tcTyFamInstEqn :: TcTyCon -> AssocInstInfo -> LTyFamInstEqn GhcRn
......@@ -2858,22 +2867,22 @@ tcTyFamInstEqn :: TcTyCon -> AssocInstInfo -> LTyFamInstEqn GhcRn
tcTyFamInstEqn fam_tc mb_clsinfo
(L loc (HsIB { hsib_ext = imp_vars
, hsib_body = FamEqn { feqn_tycon = L _ eqn_tc_name
, feqn_bndrs = mb_expl_bndrs
, hsib_body = FamEqn { feqn_bndrs = mb_expl_bndrs
, feqn_pats = hs_pats
, feqn_rhs = hs_rhs_ty }}))
= ASSERT( getName fam_tc == eqn_tc_name )
setSrcSpan loc $
= setSrcSpan loc $
do { traceTc "tcTyFamInstEqn" $
vcat [ ppr fam_tc <+> ppr hs_pats
, text "fam tc bndrs" <+> pprTyVars (tyConTyVars fam_tc)
, case mb_clsinfo of
NotAssociated -> empty
NotAssociated {} -> empty
InClsInst { ai_class = cls } -> text "class" <+> ppr cls <+> pprTyVars (classTyVars cls) ]
-- First, check the arity of visible arguments
-- If we wait until validity checking, we'll get kind errors
-- below when an arity error will be much easier to understand.
-- Note that for closed type families, kcTyFamInstEqn has already
-- checked the arity previously.
; let vis_arity = length (tyConVisibleTyVars fam_tc)
vis_pats = numVisibleArgs hs_pats
; checkTc (vis_pats == vis_arity) $
......@@ -4919,6 +4928,12 @@ incoherentRoles = (text "Roles other than" <+> quotes (text "nominal") <+>
text "for class parameters can lead to incoherence.") $$
(text "Use IncoherentInstances to allow this; bad role found")
wrongTyFamName :: Name -> Name -> SDoc
wrongTyFamName fam_tc_name eqn_tc_name
= hang (text "Mismatched type name in type family instance.")
2 (vcat [ text "Expected:" <+> ppr fam_tc_name
, text " Actual:" <+> ppr eqn_tc_name ])
addTyConCtxt :: TyCon -> TcM a -> TcM a
addTyConCtxt tc = addTyConFlavCtxt name flav
where
......
Overlap5.hs:8:3: error:
Mismatched type name in type family instance.
Expected: F
Actual: G
In the declaration for type family ‘F’
Mismatched type name in type family instance.
Expected: F
Actual: G
• In the type family declaration for ‘F’
T16002.hs:6:3: error:
Mismatched type name in type family instance.
Expected: B
Actual: A
In the declaration for type family ‘B’
Mismatched type name in type family instance.
Expected: B
Actual: A
• In the type family declaration for ‘B’
{-# LANGUAGE TemplateHaskell, TypeOperators, DataKinds #-}
{-# LANGUAGE TemplateHaskell, TypeOperators, DataKinds, TypeFamilies #-}
module T15362 where
......
T15362.hs:8:10: error:
T15362.hs:7:2: error:
• Mismatched type name in type family instance.
Expected: +
Actual: Maybe
In the declaration for type family ‘+’
• In the Template Haskell quotation
[d| type family a + b where
Maybe Zero b = b
Succ a + b = Succ (a + b) |]
• In the type family declaration for ‘+’
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wunused-top-binds #-}
module T18470 () where
type family Closed x where
Closed Int = Bool
T18470.hs:6:1: warning: [-Wunused-top-binds (in -Wextra, -Wunused-binds)]
Defined but not used: type constructor or class ‘Closed’
......@@ -718,3 +718,4 @@ test('T17775-viewpats-b', normal, compile_fail, [''])
test('T17775-viewpats-c', normal, compile_fail, [''])
test('T17775-viewpats-d', normal, compile_fail, [''])
test('T18412', normal, compile, [''])
test('T18470', normal, compile, [''])
T11623.hs:5:23: error:
Mismatched type name in type family instance.
Expected: T
Actual: Maybe
In the declaration for type family ‘T’
Mismatched type name in type family instance.
Expected: T
Actual: Maybe
• In the type family declaration for ‘T’
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment