diff options
Diffstat (limited to 'compiler/GHC/Tc/TyCl.hs')
| -rw-r--r-- | compiler/GHC/Tc/TyCl.hs | 72 |
1 files changed, 60 insertions, 12 deletions
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs index 3ada6b6dc3..e184bd178f 100644 --- a/compiler/GHC/Tc/TyCl.hs +++ b/compiler/GHC/Tc/TyCl.hs @@ -4350,7 +4350,9 @@ checkValidDataCon dflags existential_ok tc con addErrCtxt (dataConCtxt [L (noAnnSrcSpan con_loc) con_name]) $ do { let tc_tvs = tyConTyVars tc res_ty_tmpl = mkFamilyTyConApp tc (mkTyVarTys tc_tvs) - orig_res_ty = dataConOrigResTy con + arg_tys = dataConOrigArgTys con + orig_res_ty = dataConOrigResTy con + ; traceTc "checkValidDataCon" (vcat [ ppr con, ppr tc, ppr tc_tvs , ppr res_ty_tmpl <+> dcolon <+> ppr (tcTypeKind res_ty_tmpl) @@ -4387,15 +4389,20 @@ checkValidDataCon dflags existential_ok tc con -- Reason: it's really the argument of an equality constraint ; checkValidMonoType orig_res_ty - -- If we are dealing with a newtype, we allow representation - -- polymorphism regardless of whether or not UnliftedNewtypes - -- is enabled. A later check in checkNewDataCon handles this, - -- producing a better error message than checkTypeHasFixedRuntimeRep would. + -- Check for an escaping result kind + -- See Note [Check for escaping result kind] + ; checkEscapingKind con + + -- For /data/ types check that each argument has a fixed runtime rep + -- If we are dealing with a /newtype/, we allow representation + -- polymorphism regardless of whether or not UnliftedNewtypes + -- is enabled. A later check in checkNewDataCon handles this, + -- producing a better error message than checkTypeHasFixedRuntimeRep would. + ; let check_rr = checkTypeHasFixedRuntimeRep FixedRuntimeRepDataConField ; unless (isNewTyCon tc) $ - checkNoErrs $ - mapM_ (checkTypeHasFixedRuntimeRep FixedRuntimeRepDataConField) - (map scaledThing $ dataConOrigArgTys con) - -- the checkNoErrs is to prevent a panic in isVanillaDataCon + checkNoErrs $ + mapM_ (check_rr . scaledThing) arg_tys + -- The checkNoErrs is to prevent a panic in isVanillaDataCon -- (called a a few lines down), which can fall over if there is a -- bang on a representation-polymorphic argument. This is #18534, -- typecheck/should_fail/T18534 @@ -4489,9 +4496,9 @@ checkValidDataCon dflags existential_ok tc con } where bang_opts = initBangOpts dflags - con_name = dataConName con - con_loc = nameSrcSpan con_name - ctxt = ConArgCtxt con_name + con_name = dataConName con + con_loc = nameSrcSpan con_name + ctxt = ConArgCtxt con_name is_strict = \case NoSrcStrict -> bang_opt_strict_data bang_opts bang -> isSrcStrict bang @@ -4554,6 +4561,47 @@ checkNewDataCon con ok_mult One = True ok_mult _ = False + +-- | Reject nullary data constructors where a type variables +-- would escape through the result kind +-- See Note [Check for escaping result kind] +checkEscapingKind :: DataCon -> TcM () +checkEscapingKind data_con + | null eq_spec, null theta, null arg_tys + , let tau_kind = tcTypeKind res_ty + , Nothing <- occCheckExpand (univ_tvs ++ ex_tvs) tau_kind + -- Ensure that none of the tvs occur in the kind of the forall + -- /after/ expanding type synonyms. + -- See Note [Phantom type variables in kinds] in GHC.Core.Type + = failWithTc $ TcRnForAllEscapeError (dataConWrapperType data_con) tau_kind + | otherwise + = return () + where + (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, res_ty) + = dataConFullSig data_con + +{- Note [Check for escaping result kind] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider: + type T :: TYPE (BoxedRep l) + data T = MkT +This is not OK: we get + MkT :: forall l. T @l :: TYPE (BoxedRep l) +which is ill-kinded. + +For ordinary type signatures f :: blah, we make this check as part of kind-checking +the type signature; see Note [Escaping kind in type signatures] in GHC.Tc.Gen.HsType. +But for data constructors we check the type piecemeal, and there is no very +convenient place to do it. For example, note that it only applies for /nullary/ +constructors. If we had + data T = MkT Int +then the type of MkT would be MkT :: forall l. Int -> T @l, which is fine. + +So we make the check in checkValidDataCon. + +Historical note: we used to do the check in checkValidType (#20929 discusses). +-} + ------------------------------- checkValidClass :: Class -> TcM () checkValidClass cls |