Commit 2216b4d3 authored by Krzysztof Gogolewski's avatar Krzysztof Gogolewski

Reject negative type-level integers created via TH (#8412)

This commit moves the check from parser to renamer.
parent 77d2aa5f
......@@ -228,23 +228,14 @@ mkSpliceDecl other_expr = SpliceD (SpliceDecl (L (getLoc other_e
where
HsSpliceE splice = mkHsSpliceE other_expr
-- Ensure a type literal is used correctly; notably, we need the proper extension enabled,
-- and if it's an integer literal, the literal must be >= 0. This can occur with
-- -XNegativeLiterals enabled (see #8306)
mkTyLit :: Located HsTyLit -> P (LHsType RdrName)
mkTyLit lit = extension typeLiteralsEnabled >>= check
where
negLit (L _ (HsStrTy _)) = False
negLit (L _ (HsNumTy i)) = i < 0
check False =
parseErrorSDoc (getLoc lit)
(text "Illegal literal in type (use DataKinds to enable):" <+> ppr lit)
check True =
if not (negLit lit) then return (HsTyLit `fmap` lit)
else parseErrorSDoc (getLoc lit)
(text "Illegal literal in type (type literals must not be negative):" <+> ppr lit)
mkTyLit :: Located (HsTyLit) -> P (LHsType RdrName)
mkTyLit l =
do allowed <- extension typeLiteralsEnabled
if allowed
then return (HsTyLit `fmap` l)
else parseErrorSDoc (getLoc l)
(text "Illegal literal in type (use DataKinds to enable):" <+>
ppr l)
mkRoleAnnotDecl :: SrcSpan
-> Located RdrName -- type being annotated
......
......@@ -223,12 +223,17 @@ rnHsTyKi isType doc tupleTy@(HsTupleTy tup_con tys)
; (tys', fvs) <- mapFvRn (rnLHsTyKi isType doc) tys
; return (HsTupleTy tup_con tys', fvs) }
-- 1. Perhaps we should use a separate extension here?
-- 2. Check that the integer is positive?
-- Perhaps we should use a separate extension here?
-- Ensure that a type-level integer is nonnegative (#8306, #8412)
rnHsTyKi isType _ tyLit@(HsTyLit t)
= do { data_kinds <- xoptM Opt_DataKinds
; unless (data_kinds || isType) (addErr (dataKindsErr isType tyLit))
; when (negLit t) (addErr negLitErr)
; return (HsTyLit t, emptyFVs) }
where
negLit (HsStrTy _) = False
negLit (HsNumTy i) = i < 0
negLitErr = ptext (sLit "Illegal literal in type (type literals must not be negative):") <+> ppr tyLit
rnHsTyKi isType doc (HsAppTy ty1 ty2)
= do { (ty1', fvs1) <- rnLHsTyKi isType doc ty1
......
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