Commit 80dfcee6 authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Marge Bot

Be more careful when naming TyCon binders

This patch fixes two rather gnarly test cases:
  * Trac #16342 (mutual recursion)
    See Note [Tricky scoping in generaliseTcTyCon]

  * Trac #16221 (shadowing)
    See Note [Unification variables need fresh Names]

The main changes are:

* Substantial reworking of TcTyClsDecls.generaliseTcTyCon
  This is the big change, and involves the rather tricky
  function TcHsSyn.zonkRecTyVarBndrs.

  See Note [Inferring kinds for type declarations] and
  Note [Tricky scoping in generaliseTcTyCon] for the details.

* bindExplicitTKBndrs_Tv and bindImplicitTKBndrs_Tv both now
  allocate /freshly-named/ unification variables. Indeed, more
  generally, unification variables are always fresh; see
  Note [Unification variables need fresh Names] in TcMType

* Clarify the role of tcTyConScopedTyVars.
  See Note [Scoped tyvars in a TcTyCon] in TyCon

As usual, this dragged in some more refactoring:

* Renamed TcMType.zonkTyCoVarBndr to zonkAndSkolemise

* I renamed checkValidTelescope to checkTyConTelescope;
  it's only used on TyCons, and indeed takes a TyCon as argument.

* I folded the slightly-mysterious reportFloatingKvs into
  checkTyConTelescope. (Previously all its calls immediately
  followed a call to checkTyConTelescope.)  It makes much more
  sense there.

* I inlined some called-once functions to simplify
  checkValidTyFamEqn. It's less spaghetti-like now.

* This patch also fixes Trac #16251.  I'm not quite sure why #16251
  went wrong in the first place, nor how this patch fixes it, but
  hey, it's good, and life is short.
parent e6ce1743
Pipeline #3105 passed with stages
in 317 minutes and 17 seconds
...@@ -208,7 +208,7 @@ get_scoped_tvs (dL->L _ signature) ...@@ -208,7 +208,7 @@ get_scoped_tvs (dL->L _ signature)
| HsIB { hsib_ext = implicit_vars | HsIB { hsib_ext = implicit_vars
, hsib_body = hs_ty } <- sig , hsib_body = hs_ty } <- sig
, (explicit_vars, _) <- splitLHsForAllTy hs_ty , (explicit_vars, _) <- splitLHsForAllTy hs_ty
= implicit_vars ++ map hsLTyVarName explicit_vars = implicit_vars ++ hsLTyVarNames explicit_vars
get_scoped_tvs_from_sig (XHsImplicitBndrs _) get_scoped_tvs_from_sig (XHsImplicitBndrs _)
= panic "get_scoped_tvs_from_sig" = panic "get_scoped_tvs_from_sig"
...@@ -1037,7 +1037,7 @@ addHsTyVarBinds :: [LHsTyVarBndr GhcRn] -- the binders to be added ...@@ -1037,7 +1037,7 @@ addHsTyVarBinds :: [LHsTyVarBndr GhcRn] -- the binders to be added
-> (Core [TH.TyVarBndrQ] -> DsM (Core (TH.Q a))) -- action in the ext env -> (Core [TH.TyVarBndrQ] -> DsM (Core (TH.Q a))) -- action in the ext env
-> DsM (Core (TH.Q a)) -> DsM (Core (TH.Q a))
addHsTyVarBinds exp_tvs thing_inside addHsTyVarBinds exp_tvs thing_inside
= do { fresh_exp_names <- mkGenSyms (map hsLTyVarName exp_tvs) = do { fresh_exp_names <- mkGenSyms (hsLTyVarNames exp_tvs)
; term <- addBinds fresh_exp_names $ ; term <- addBinds fresh_exp_names $
do { kbs <- repList tyVarBndrQTyConName mk_tv_bndr do { kbs <- repList tyVarBndrQTyConName mk_tv_bndr
(exp_tvs `zip` fresh_exp_names) (exp_tvs `zip` fresh_exp_names)
......
...@@ -53,7 +53,7 @@ module HsTypes ( ...@@ -53,7 +53,7 @@ module HsTypes (
isHsKindedTyVar, hsTvbAllKinded, isLHsForAllTy, isHsKindedTyVar, hsTvbAllKinded, isLHsForAllTy,
hsScopedTvs, hsWcScopedTvs, dropWildCards, hsScopedTvs, hsWcScopedTvs, dropWildCards,
hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames, hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames,
hsLTyVarName, hsLTyVarLocName, hsExplicitLTyVarNames, hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsExplicitLTyVarNames,
splitLHsInstDeclTy, getLHsInstDeclHead, getLHsInstDeclClass_maybe, splitLHsInstDeclTy, getLHsInstDeclHead, getLHsInstDeclClass_maybe,
splitLHsPatSynTy, splitLHsPatSynTy,
splitLHsForAllTy, splitLHsForAllTyInvis, splitLHsForAllTy, splitLHsForAllTyInvis,
...@@ -949,7 +949,7 @@ hsWcScopedTvs sig_ty ...@@ -949,7 +949,7 @@ hsWcScopedTvs sig_ty
, hsib_body = sig_ty2 } <- sig_ty1 , hsib_body = sig_ty2 } <- sig_ty1
= case sig_ty2 of = case sig_ty2 of
L _ (HsForAllTy { hst_bndrs = tvs }) -> vars ++ nwcs ++ L _ (HsForAllTy { hst_bndrs = tvs }) -> vars ++ nwcs ++
map hsLTyVarName tvs hsLTyVarNames tvs
-- include kind variables only if the type is headed by forall -- include kind variables only if the type is headed by forall
-- (this is consistent with GHC 7 behaviour) -- (this is consistent with GHC 7 behaviour)
_ -> nwcs _ -> nwcs
...@@ -962,7 +962,7 @@ hsScopedTvs sig_ty ...@@ -962,7 +962,7 @@ hsScopedTvs sig_ty
| HsIB { hsib_ext = vars | HsIB { hsib_ext = vars
, hsib_body = sig_ty2 } <- sig_ty , hsib_body = sig_ty2 } <- sig_ty
, L _ (HsForAllTy { hst_bndrs = tvs }) <- sig_ty2 , L _ (HsForAllTy { hst_bndrs = tvs }) <- sig_ty2
= vars ++ map hsLTyVarName tvs = vars ++ hsLTyVarNames tvs
| otherwise | otherwise
= [] = []
...@@ -988,6 +988,9 @@ hsTyVarName (XTyVarBndr{}) = panic "hsTyVarName" ...@@ -988,6 +988,9 @@ hsTyVarName (XTyVarBndr{}) = panic "hsTyVarName"
hsLTyVarName :: LHsTyVarBndr pass -> IdP pass hsLTyVarName :: LHsTyVarBndr pass -> IdP pass
hsLTyVarName = hsTyVarName . unLoc hsLTyVarName = hsTyVarName . unLoc
hsLTyVarNames :: [LHsTyVarBndr pass] -> [IdP pass]
hsLTyVarNames = map hsLTyVarName
hsExplicitLTyVarNames :: LHsQTyVars pass -> [IdP pass] hsExplicitLTyVarNames :: LHsQTyVars pass -> [IdP pass]
-- Explicit variables only -- Explicit variables only
hsExplicitLTyVarNames qtvs = map hsLTyVarName (hsQTvExplicit qtvs) hsExplicitLTyVarNames qtvs = map hsLTyVarName (hsQTvExplicit qtvs)
...@@ -996,7 +999,7 @@ hsAllLTyVarNames :: LHsQTyVars GhcRn -> [Name] ...@@ -996,7 +999,7 @@ hsAllLTyVarNames :: LHsQTyVars GhcRn -> [Name]
-- All variables -- All variables
hsAllLTyVarNames (HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = kvs } hsAllLTyVarNames (HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = kvs }
, hsq_explicit = tvs }) , hsq_explicit = tvs })
= kvs ++ map hsLTyVarName tvs = kvs ++ hsLTyVarNames tvs
hsAllLTyVarNames (XLHsQTyVars _) = panic "hsAllLTyVarNames" hsAllLTyVarNames (XLHsQTyVars _) = panic "hsAllLTyVarNames"
hsLTyVarLocName :: LHsTyVarBndr pass -> Located (IdP pass) hsLTyVarLocName :: LHsTyVarBndr pass -> Located (IdP pass)
...@@ -1255,7 +1258,7 @@ splitLHsInstDeclTy :: LHsSigType GhcRn ...@@ -1255,7 +1258,7 @@ splitLHsInstDeclTy :: LHsSigType GhcRn
splitLHsInstDeclTy (HsIB { hsib_ext = itkvs splitLHsInstDeclTy (HsIB { hsib_ext = itkvs
, hsib_body = inst_ty }) , hsib_body = inst_ty })
| (tvs, cxt, body_ty) <- splitLHsSigmaTyInvis inst_ty | (tvs, cxt, body_ty) <- splitLHsSigmaTyInvis inst_ty
= (itkvs ++ map hsLTyVarName tvs, cxt, body_ty) = (itkvs ++ hsLTyVarNames tvs, cxt, body_ty)
-- Return implicitly bound type and kind vars -- Return implicitly bound type and kind vars
-- For an instance decl, all of them are in scope -- For an instance decl, all of them are in scope
splitLHsInstDeclTy (XHsImplicitBndrs _) = panic "splitLHsInstDeclTy" splitLHsInstDeclTy (XHsImplicitBndrs _) = panic "splitLHsInstDeclTy"
......
...@@ -776,8 +776,7 @@ rnFamInstEqn doc mb_cls rhs_kvars ...@@ -776,8 +776,7 @@ rnFamInstEqn doc mb_cls rhs_kvars
inst_tvs = case mb_cls of inst_tvs = case mb_cls of
Nothing -> [] Nothing -> []
Just (_, inst_tvs) -> inst_tvs Just (_, inst_tvs) -> inst_tvs
all_nms = all_imp_var_names all_nms = all_imp_var_names ++ hsLTyVarNames bndrs'
++ map hsLTyVarName bndrs'
; warnUnusedTypePatterns all_nms nms_used ; warnUnusedTypePatterns all_nms nms_used
; return ((bndrs', pats', payload'), rhs_fvs `plusFV` pat_fvs) } ; return ((bndrs', pats', payload'), rhs_fvs `plusFV` pat_fvs) }
...@@ -1809,7 +1808,7 @@ rnLDerivStrategy doc mds thing_inside ...@@ -1809,7 +1808,7 @@ rnLDerivStrategy doc mds thing_inside
let HsIB { hsib_ext = via_imp_tvs let HsIB { hsib_ext = via_imp_tvs
, hsib_body = via_body } = via_ty' , hsib_body = via_body } = via_ty'
(via_exp_tv_bndrs, _, _) = splitLHsSigmaTy via_body (via_exp_tv_bndrs, _, _) = splitLHsSigmaTy via_body
via_exp_tvs = map hsLTyVarName via_exp_tv_bndrs via_exp_tvs = hsLTyVarNames via_exp_tv_bndrs
via_tvs = via_imp_tvs ++ via_exp_tvs via_tvs = via_imp_tvs ++ via_exp_tvs
(thing, fvs2) <- extendTyVarEnvFVRn via_tvs $ (thing, fvs2) <- extendTyVarEnvFVRn via_tvs $
thing_inside via_tvs (ppr via_ty') thing_inside via_tvs (ppr via_ty')
......
...@@ -34,7 +34,7 @@ module TcHsSyn ( ...@@ -34,7 +34,7 @@ module TcHsSyn (
zonkTopBndrs, zonkTopBndrs,
ZonkEnv, ZonkFlexi(..), emptyZonkEnv, mkEmptyZonkEnv, initZonkEnv, ZonkEnv, ZonkFlexi(..), emptyZonkEnv, mkEmptyZonkEnv, initZonkEnv,
zonkTyVarBinders, zonkTyVarBindersX, zonkTyVarBinderX, zonkTyVarBinders, zonkTyVarBindersX, zonkTyVarBinderX,
zonkTyBndrs, zonkTyBndrsX, zonkTyBndrs, zonkTyBndrsX, zonkRecTyVarBndrs,
zonkTcTypeToType, zonkTcTypeToTypeX, zonkTcTypeToType, zonkTcTypeToTypeX,
zonkTcTypesToTypes, zonkTcTypesToTypesX, zonkTcTypesToTypes, zonkTcTypesToTypesX,
zonkTyVarOcc, zonkTyVarOcc,
...@@ -278,7 +278,11 @@ data ZonkFlexi -- See Note [Un-unified unification variables] ...@@ -278,7 +278,11 @@ data ZonkFlexi -- See Note [Un-unified unification variables]
| RuntimeUnkFlexi -- Used in the GHCi debugger | RuntimeUnkFlexi -- Used in the GHCi debugger
instance Outputable ZonkEnv where instance Outputable ZonkEnv where
ppr (ZonkEnv { ze_id_env = var_env}) = pprUFM var_env (vcat . map ppr) ppr (ZonkEnv { ze_tv_env = tv_env
, ze_id_env = id_env })
= text "ZE" <+> braces (vcat
[ text "ze_tv_env =" <+> ppr tv_env
, text "ze_id_env =" <+> ppr id_env ])
-- The EvBinds have to already be zonked, but that's usually the case. -- The EvBinds have to already be zonked, but that's usually the case.
emptyZonkEnv :: TcM ZonkEnv emptyZonkEnv :: TcM ZonkEnv
...@@ -292,9 +296,9 @@ mkEmptyZonkEnv flexi ...@@ -292,9 +296,9 @@ mkEmptyZonkEnv flexi
, ze_id_env = emptyVarEnv , ze_id_env = emptyVarEnv
, ze_meta_tv_env = mtv_env_ref }) } , ze_meta_tv_env = mtv_env_ref }) }
initZonkEnv :: (ZonkEnv -> a -> TcM b) -> a -> TcM b initZonkEnv :: (ZonkEnv -> TcM b) -> TcM b
initZonkEnv do_it x = do { ze <- mkEmptyZonkEnv DefaultFlexi initZonkEnv thing_inside = do { ze <- mkEmptyZonkEnv DefaultFlexi
; do_it ze x } ; thing_inside ze }
-- | Extend the knot-tied environment. -- | Extend the knot-tied environment.
extendIdZonkEnvRec :: ZonkEnv -> [Var] -> ZonkEnv extendIdZonkEnvRec :: ZonkEnv -> [Var] -> ZonkEnv
...@@ -324,6 +328,12 @@ extendTyZonkEnv1 :: ZonkEnv -> TyVar -> ZonkEnv ...@@ -324,6 +328,12 @@ extendTyZonkEnv1 :: ZonkEnv -> TyVar -> ZonkEnv
extendTyZonkEnv1 ze@(ZonkEnv { ze_tv_env = ty_env }) tv extendTyZonkEnv1 ze@(ZonkEnv { ze_tv_env = ty_env }) tv
= ze { ze_tv_env = extendVarEnv ty_env tv tv } = ze { ze_tv_env = extendVarEnv ty_env tv tv }
extendTyZonkEnvN :: ZonkEnv -> [(Name,TyVar)] -> ZonkEnv
extendTyZonkEnvN ze@(ZonkEnv { ze_tv_env = ty_env }) pairs
= ze { ze_tv_env = foldl add ty_env pairs }
where
add env (name, tv) = extendVarEnv_Directly env (getUnique name) tv
setZonkType :: ZonkEnv -> ZonkFlexi -> ZonkEnv setZonkType :: ZonkEnv -> ZonkFlexi -> ZonkEnv
setZonkType ze flexi = ze { ze_flexi = flexi } setZonkType ze flexi = ze { ze_flexi = flexi }
...@@ -374,7 +384,7 @@ zonkIdBndrs :: ZonkEnv -> [TcId] -> TcM [Id] ...@@ -374,7 +384,7 @@ zonkIdBndrs :: ZonkEnv -> [TcId] -> TcM [Id]
zonkIdBndrs env ids = mapM (zonkIdBndr env) ids zonkIdBndrs env ids = mapM (zonkIdBndr env) ids
zonkTopBndrs :: [TcId] -> TcM [Id] zonkTopBndrs :: [TcId] -> TcM [Id]
zonkTopBndrs ids = initZonkEnv zonkIdBndrs ids zonkTopBndrs ids = initZonkEnv $ \ ze -> zonkIdBndrs ze ids
zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTcId -> TcM (FieldOcc GhcTc) zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTcId -> TcM (FieldOcc GhcTc)
zonkFieldOcc env (FieldOcc sel lbl) zonkFieldOcc env (FieldOcc sel lbl)
...@@ -419,7 +429,7 @@ zonkCoreBndrsX :: ZonkEnv -> [Var] -> TcM (ZonkEnv, [Var]) ...@@ -419,7 +429,7 @@ zonkCoreBndrsX :: ZonkEnv -> [Var] -> TcM (ZonkEnv, [Var])
zonkCoreBndrsX = mapAccumLM zonkCoreBndrX zonkCoreBndrsX = mapAccumLM zonkCoreBndrX
zonkTyBndrs :: [TcTyVar] -> TcM (ZonkEnv, [TyVar]) zonkTyBndrs :: [TcTyVar] -> TcM (ZonkEnv, [TyVar])
zonkTyBndrs = initZonkEnv zonkTyBndrsX zonkTyBndrs tvs = initZonkEnv $ \ze -> zonkTyBndrsX ze tvs
zonkTyBndrsX :: ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TyVar]) zonkTyBndrsX :: ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TyVar])
zonkTyBndrsX = mapAccumLM zonkTyBndrX zonkTyBndrsX = mapAccumLM zonkTyBndrX
...@@ -436,7 +446,7 @@ zonkTyBndrX env tv ...@@ -436,7 +446,7 @@ zonkTyBndrX env tv
zonkTyVarBinders :: [VarBndr TcTyVar vis] zonkTyVarBinders :: [VarBndr TcTyVar vis]
-> TcM (ZonkEnv, [VarBndr TyVar vis]) -> TcM (ZonkEnv, [VarBndr TyVar vis])
zonkTyVarBinders = initZonkEnv zonkTyVarBindersX zonkTyVarBinders tvbs = initZonkEnv $ \ ze -> zonkTyVarBindersX ze tvbs
zonkTyVarBindersX :: ZonkEnv -> [VarBndr TcTyVar vis] zonkTyVarBindersX :: ZonkEnv -> [VarBndr TcTyVar vis]
-> TcM (ZonkEnv, [VarBndr TyVar vis]) -> TcM (ZonkEnv, [VarBndr TyVar vis])
...@@ -449,11 +459,27 @@ zonkTyVarBinderX env (Bndr tv vis) ...@@ -449,11 +459,27 @@ zonkTyVarBinderX env (Bndr tv vis)
= do { (env', tv') <- zonkTyBndrX env tv = do { (env', tv') <- zonkTyBndrX env tv
; return (env', Bndr tv' vis) } ; return (env', Bndr tv' vis) }
zonkRecTyVarBndrs :: [Name] -> [TcTyVar] -> TcM (ZonkEnv, [TyVar])
-- This rather specialised function is used in exactly one place.
-- See Note [Tricky scoping in generaliseTcTyCon] in TcTyClsDecls.
zonkRecTyVarBndrs names tc_tvs
= initZonkEnv $ \ ze ->
fixM $ \ ~(_, rec_new_tvs) ->
do { let ze' = extendTyZonkEnvN ze $
zipWithLazy (\ tc_tv new_tv -> (getName tc_tv, new_tv))
tc_tvs rec_new_tvs
; new_tvs <- zipWithM (zonk_one ze') names tc_tvs
; return (ze', new_tvs) }
where
zonk_one ze name tc_tv
= do { ki <- zonkTcTypeToTypeX ze (tyVarKind tc_tv)
; return (mkTyVar name ki) }
zonkTopExpr :: HsExpr GhcTcId -> TcM (HsExpr GhcTc) zonkTopExpr :: HsExpr GhcTcId -> TcM (HsExpr GhcTc)
zonkTopExpr e = initZonkEnv zonkExpr e zonkTopExpr e = initZonkEnv $ \ ze -> zonkExpr ze e
zonkTopLExpr :: LHsExpr GhcTcId -> TcM (LHsExpr GhcTc) zonkTopLExpr :: LHsExpr GhcTcId -> TcM (LHsExpr GhcTc)
zonkTopLExpr e = initZonkEnv zonkLExpr e zonkTopLExpr e = initZonkEnv $ \ ze -> zonkLExpr ze e
zonkTopDecls :: Bag EvBind zonkTopDecls :: Bag EvBind
-> LHsBinds GhcTcId -> LHsBinds GhcTcId
...@@ -466,7 +492,7 @@ zonkTopDecls :: Bag EvBind ...@@ -466,7 +492,7 @@ zonkTopDecls :: Bag EvBind
[LTcSpecPrag], [LTcSpecPrag],
[LRuleDecl GhcTc]) [LRuleDecl GhcTc])
zonkTopDecls ev_binds binds rules imp_specs fords zonkTopDecls ev_binds binds rules imp_specs fords
= do { (env1, ev_binds') <- initZonkEnv zonkEvBinds ev_binds = do { (env1, ev_binds') <- initZonkEnv $ \ ze -> zonkEvBinds ze ev_binds
; (env2, binds') <- zonkRecMonoBinds env1 binds ; (env2, binds') <- zonkRecMonoBinds env1 binds
-- Top level is implicitly recursive -- Top level is implicitly recursive
; rules' <- zonkRules env2 rules ; rules' <- zonkRules env2 rules
...@@ -1744,9 +1770,9 @@ Solution: (see Trac #15552 for other variants) ...@@ -1744,9 +1770,9 @@ Solution: (see Trac #15552 for other variants)
* The map is of course stateful, held in a TcRef. (That is unlike * The map is of course stateful, held in a TcRef. (That is unlike
the treatment of lexically-scoped variables in ze_tv_env and the treatment of lexically-scoped variables in ze_tv_env and
ze_id_env. ze_id_env.)
Is the extra work worth it. Some non-sytematic perf measurements Is the extra work worth it? Some non-sytematic perf measurements
suggest that compiler allocation is reduced overall (by 0.5% or so) suggest that compiler allocation is reduced overall (by 0.5% or so)
but compile time really doesn't change. but compile time really doesn't change.
-} -}
...@@ -1865,13 +1891,13 @@ zonkTcTyConToTyCon tc ...@@ -1865,13 +1891,13 @@ zonkTcTyConToTyCon tc
-- Confused by zonking? See Note [What is zonking?] in TcMType. -- Confused by zonking? See Note [What is zonking?] in TcMType.
zonkTcTypeToType :: TcType -> TcM Type zonkTcTypeToType :: TcType -> TcM Type
zonkTcTypeToType = initZonkEnv zonkTcTypeToTypeX zonkTcTypeToType ty = initZonkEnv $ \ ze -> zonkTcTypeToTypeX ze ty
zonkTcTypeToTypeX :: ZonkEnv -> TcType -> TcM Type zonkTcTypeToTypeX :: ZonkEnv -> TcType -> TcM Type
zonkTcTypeToTypeX = mapType zonk_tycomapper zonkTcTypeToTypeX = mapType zonk_tycomapper
zonkTcTypesToTypes :: [TcType] -> TcM [Type] zonkTcTypesToTypes :: [TcType] -> TcM [Type]
zonkTcTypesToTypes = initZonkEnv zonkTcTypesToTypesX zonkTcTypesToTypes tys = initZonkEnv $ \ ze -> zonkTcTypesToTypesX ze tys
zonkTcTypesToTypesX :: ZonkEnv -> [TcType] -> TcM [Type] zonkTcTypesToTypesX :: ZonkEnv -> [TcType] -> TcM [Type]
zonkTcTypesToTypesX env tys = mapM (zonkTcTypeToTypeX env) tys zonkTcTypesToTypesX env tys = mapM (zonkTcTypeToTypeX env) tys
......
This diff is collapsed.
This diff is collapsed.
...@@ -382,8 +382,8 @@ tcPatSynSig name sig_ty ...@@ -382,8 +382,8 @@ tcPatSynSig name sig_ty
-- e.g. pattern Zero <- 0# (Trac #12094) -- e.g. pattern Zero <- 0# (Trac #12094)
; return (req, prov, body_ty) } ; return (req, prov, body_ty) }
; let ungen_patsyn_ty = build_patsyn_type [] implicit_tvs univ_tvs req ; let ungen_patsyn_ty = build_patsyn_type [] implicit_tvs univ_tvs
ex_tvs prov body_ty req ex_tvs prov body_ty
-- Kind generalisation -- Kind generalisation
; kvs <- kindGeneralize ungen_patsyn_ty ; kvs <- kindGeneralize ungen_patsyn_ty
......
This diff is collapsed.
This diff is collapsed.
...@@ -871,24 +871,42 @@ data TyCon ...@@ -871,24 +871,42 @@ data TyCon
-- See Note [The binders/kind/arity fields of a TyCon] -- See Note [The binders/kind/arity fields of a TyCon]
tyConBinders :: [TyConBinder], -- ^ Full binders tyConBinders :: [TyConBinder], -- ^ Full binders
tyConTyVars :: [TyVar], -- ^ TyVar binders tyConTyVars :: [TyVar], -- ^ TyVar binders
tyConResKind :: Kind, -- ^ Result kind tyConResKind :: Kind, -- ^ Result kind
tyConKind :: Kind, -- ^ Kind of this TyCon tyConKind :: Kind, -- ^ Kind of this TyCon
tyConArity :: Arity, -- ^ Arity tyConArity :: Arity, -- ^ Arity
-- NB: the TyConArity of a TcTyCon must match
-- the number of Required (positional, user-specified)
-- arguments to the type constructor; see the use
-- of tyConArity in generaliseTcTyCon
tcTyConScopedTyVars :: [(Name,TyVar)], tcTyConScopedTyVars :: [(Name,TyVar)],
-- ^ Scoped tyvars over the tycon's body -- ^ Scoped tyvars over the tycon's body
-- See Note [How TcTyCons work] in TcTyClsDecls -- See Note [Scoped tyvars in a TcTyCon]
-- Order *does* matter: for TcTyCons with a CUSK,
-- it's the correct dependency order. For TcTyCons
-- without a CUSK, it's the original left-to-right
-- that the user wrote. Nec'y for getting Specified
-- variables in the right order.
tcTyConIsPoly :: Bool, -- ^ Is this TcTyCon already generalized? tcTyConIsPoly :: Bool, -- ^ Is this TcTyCon already generalized?
tcTyConFlavour :: TyConFlavour tcTyConFlavour :: TyConFlavour
-- ^ What sort of 'TyCon' this represents. -- ^ What sort of 'TyCon' this represents.
} }
{- Note [Scoped tyvars in a TcTyCon]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The tcTyConScopedTyVars field records the lexicial-binding connection
between the original, user-specified Name (i.e. thing in scope) and
the TcTyVar that the Name is bound to.
Order *does* matter; the tcTyConScopedTyvars list consists of
specified_tvs ++ required_tvs
where
* specified ones first
* required_tvs the same as tyConTyVars
* tyConArity = length required_tvs
See also Note [How TcTyCons work] in TcTyClsDecls
-}
-- | Represents right-hand-sides of 'TyCon's for algebraic types -- | Represents right-hand-sides of 'TyCon's for algebraic types
data AlgTyConRhs data AlgTyConRhs
......
...@@ -69,7 +69,7 @@ test('T2664a', normal, compile, ['']) ...@@ -69,7 +69,7 @@ test('T2664a', normal, compile, [''])
test('T2544', normal, compile_fail, ['']) test('T2544', normal, compile_fail, [''])
test('T1897b', normal, compile_fail, ['']) test('T1897b', normal, compile_fail, [''])
test('T5439', normal, compile_fail, ['']) test('T5439', normal, compile_fail, [''])
test('T5515', when(compiler_debugged(), expect_broken(16251)), compile_fail, ['']) test('T5515', normal, compile_fail, [''])
  • @simonpj, the description for this commit mentions that it fixes #16221 (closed) and #16342 (closed). But as far as I can tell, this patch doesn't check in any test cases for them. Was this intended?

Please register or sign in to reply
test('T5934', normal, compile_fail, ['']) test('T5934', normal, compile_fail, [''])
test('T6123', normal, compile_fail, ['']) test('T6123', normal, compile_fail, [''])
test('ExtraTcsUntch', normal, compile_fail, ['']) test('ExtraTcsUntch', normal, compile_fail, [''])
......
...@@ -7,22 +7,22 @@ tc141.hs:11:12: error: ...@@ -7,22 +7,22 @@ tc141.hs:11:12: error:
In a pattern binding: (p :: a, q :: a) = x In a pattern binding: (p :: a, q :: a) = x
tc141.hs:11:31: error: tc141.hs:11:31: error:
• Couldn't match expected type ‘a2’ with actual type ‘a • Couldn't match expected type ‘a1’ with actual type ‘b
‘a2’ is a rigid type variable bound by ‘a1’ is a rigid type variable bound by
an expression type signature: an expression type signature:
forall a2. a2 forall a1. a1
at tc141.hs:11:34 at tc141.hs:11:34
a’ is a rigid type variable bound by b’ is a rigid type variable bound by
the inferred type of f :: (a, a) -> (a1, a) the inferred type of f :: (b, b) -> (a, b)
at tc141.hs:11:1-37 at tc141.hs:11:1-37
• In the expression: q :: a • In the expression: q :: a
In the expression: (q :: a, p) In the expression: (q :: a, p)
In the expression: let (p :: a, q :: a) = x in (q :: a, p) In the expression: let (p :: a, q :: a) = x in (q :: a, p)
• Relevant bindings include • Relevant bindings include
p :: a (bound at tc141.hs:11:12) p :: b (bound at tc141.hs:11:12)
q :: a (bound at tc141.hs:11:17) q :: b (bound at tc141.hs:11:17)
x :: (a, a) (bound at tc141.hs:11:3) x :: (b, b) (bound at tc141.hs:11:3)
f :: (a, a) -> (a1, a) (bound at tc141.hs:11:1) f :: (b, b) -> (a, b) (bound at tc141.hs:11:1)
tc141.hs:13:13: error: tc141.hs:13:13: error:
• You cannot bind scoped type variable ‘a’ • You cannot bind scoped type variable ‘a’
......
...@@ -3,10 +3,10 @@ T2688.hs:8:14: error: ...@@ -3,10 +3,10 @@ T2688.hs:8:14: error:
• Couldn't match expected type ‘v’ with actual type ‘s’ • Couldn't match expected type ‘v’ with actual type ‘s’
‘s’ is a rigid type variable bound by ‘s’ is a rigid type variable bound by
the class declaration for ‘VectorSpace’ the class declaration for ‘VectorSpace’
at T2688.hs:(5,1)-(8,23) at T2688.hs:5:21
‘v’ is a rigid type variable bound by ‘v’ is a rigid type variable bound by
the class declaration for ‘VectorSpace’ the class declaration for ‘VectorSpace’
at T2688.hs:(5,1)-(8,23) at T2688.hs:5:19
• In the expression: v *^ (1 / s) • In the expression: v *^ (1 / s)
In an equation for ‘^/’: v ^/ s = v *^ (1 / s) In an equation for ‘^/’: v ^/ s = v *^ (1 / s)
• Relevant bindings include • Relevant bindings include
......
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