[Git][ghc/ghc][wip/T18470] Don't mark closed type family equations as occurrences
Ryan Scott
gitlab at gitlab.haskell.org
Tue Jul 28 23:59:12 UTC 2020
Ryan Scott pushed to branch wip/T18470 at Glasgow Haskell Compiler / GHC
Commits:
00e09d27 by Ryan Scott at 2020-07-28T19:57:25-04:00
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.
- - - - -
11 changed files:
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/TyCl.hs
- testsuite/tests/indexed-types/should_fail/Overlap5.stderr
- testsuite/tests/rename/should_fail/T16002.stderr
- testsuite/tests/th/T15362.hs
- testsuite/tests/th/T15362.stderr
- + testsuite/tests/typecheck/should_compile/T18470.hs
- + testsuite/tests/typecheck/should_compile/T18470.stderr
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/T11623.stderr
Changes:
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -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 })
@@ -760,8 +760,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
@@ -776,14 +780,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
@@ -806,48 +810,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
@@ -995,6 +1013,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.
-}
@@ -1947,7 +2010,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
@@ -1959,18 +2022,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
@@ -2114,13 +2175,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)
=====================================
compiler/GHC/Tc/Instance/Class.hs
=====================================
@@ -67,8 +67,8 @@ data AssocInstInfo
}
isNotAssociated :: AssocInstInfo -> Bool
-isNotAssociated NotAssociated = True
-isNotAssociated (InClsInst {}) = False
+isNotAssociated (NotAssociated {}) = True
+isNotAssociated (InClsInst {}) = False
{- *******************************************************************
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -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
=====================================
testsuite/tests/indexed-types/should_fail/Overlap5.stderr
=====================================
@@ -1,6 +1,6 @@
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’
=====================================
testsuite/tests/rename/should_fail/T16002.stderr
=====================================
@@ -1,6 +1,6 @@
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’
=====================================
testsuite/tests/th/T15362.hs
=====================================
@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell, TypeOperators, DataKinds #-}
+{-# LANGUAGE TemplateHaskell, TypeOperators, DataKinds, TypeFamilies #-}
module T15362 where
=====================================
testsuite/tests/th/T15362.stderr
=====================================
@@ -1,10 +1,6 @@
-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 ‘+’
=====================================
testsuite/tests/typecheck/should_compile/T18470.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wunused-top-binds #-}
+
+module T18470 () where
+
+type family Closed x where
+ Closed Int = Bool
=====================================
testsuite/tests/typecheck/should_compile/T18470.stderr
=====================================
@@ -0,0 +1,3 @@
+
+T18470.hs:6:1: warning: [-Wunused-top-binds (in -Wextra, -Wunused-binds)]
+ Defined but not used: type constructor or class ‘Closed’
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -717,3 +717,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, [''])
=====================================
testsuite/tests/typecheck/should_fail/T11623.stderr
=====================================
@@ -1,6 +1,6 @@
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’
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00e09d271aa464246995633cc4cad41358db40ea
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00e09d271aa464246995633cc4cad41358db40ea
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200728/a55da305/attachment-0001.html>
More information about the ghc-commits
mailing list