Repository : ssh://g...@git.haskell.org/ghc
On branch : master
Link :
http://ghc.haskell.org/trac/ghc/changeset/2216b4d37fa12f7e9d16d8942d3ec9d0ad5376e6/ghc
>---------------------------------------------------------------
commit 2216b4d37fa12f7e9d16d8942d3ec9d0ad5376e6
Author: Krzysztof Gogolewski <krz.gogolew...@gmail.com>
Date: Sat Oct 5 17:21:44 2013 +0200
Reject negative type-level integers created via TH (#8412)
This commit moves the check from parser to renamer.
>---------------------------------------------------------------
2216b4d37fa12f7e9d16d8942d3ec9d0ad5376e6
compiler/parser/RdrHsSyn.lhs | 25 ++++++++-----------------
compiler/rename/RnTypes.lhs | 9 +++++++--
2 files changed, 15 insertions(+), 19 deletions(-)
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index f024d5c..47abe3a 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -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
diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index 9aeae7e..0db92e8 100644
--- a/compiler/rename/RnTypes.lhs
+++ b/compiler/rename/RnTypes.lhs
@@ -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
_______________________________________________
ghc-commits mailing list
ghc-commits@haskell.org
http://www.haskell.org/mailman/listinfo/ghc-commits
