Complain about illegal type literals in renamer, not parser
authorSimon Peyton Jones <simonpj@microsoft.com>
Fri, 26 Sep 2014 11:34:13 +0000 (12:34 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Fri, 26 Sep 2014 11:34:53 +0000 (12:34 +0100)
A premature complaint was causing Trac #9634.  Acutally this
change also simplifies the lexer and eliminates duplication.
(The renamer was already making the check, as it happens.)

compiler/parser/Lexer.x
compiler/parser/Parser.y.pp
compiler/parser/RdrHsSyn.lhs
compiler/rename/RnTypes.lhs
testsuite/tests/parser/should_fail/T3811b.stderr
testsuite/tests/typecheck/should_fail/T9634.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T9634.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/all.T
testsuite/tests/typecheck/should_fail/tcfail094.stderr

index 8fd5bd9..aa5ddc3 100644 (file)
@@ -65,7 +65,6 @@ module Lexer (
    getLexState, popLexState, pushLexState,
    extension, bangPatEnabled, datatypeContextsEnabled,
    traditionalRecordSyntaxEnabled,
-   typeLiteralsEnabled,
    explicitForallEnabled,
    inRulePrag,
    explicitNamespacesEnabled,
@@ -1950,7 +1949,6 @@ data ExtBits
   | NondecreasingIndentationBit
   | SafeHaskellBit
   | TraditionalRecordSyntaxBit
-  | TypeLiteralsBit
   | ExplicitNamespacesBit
   | LambdaCaseBit
   | BinaryLiteralsBit
@@ -2002,8 +2000,6 @@ sccProfilingOn :: ExtsBitmap -> Bool
 sccProfilingOn = xtest SccProfilingOnBit
 traditionalRecordSyntaxEnabled :: ExtsBitmap -> Bool
 traditionalRecordSyntaxEnabled = xtest TraditionalRecordSyntaxBit
-typeLiteralsEnabled :: ExtsBitmap -> Bool
-typeLiteralsEnabled = xtest TypeLiteralsBit
 
 explicitNamespacesEnabled :: ExtsBitmap -> Bool
 explicitNamespacesEnabled = xtest ExplicitNamespacesBit
@@ -2074,7 +2070,6 @@ mkPState flags buf loc =
                .|. NondecreasingIndentationBit `setBitIf` xopt Opt_NondecreasingIndentation flags
                .|. SafeHaskellBit              `setBitIf` safeImportsOn                     flags
                .|. TraditionalRecordSyntaxBit  `setBitIf` xopt Opt_TraditionalRecordSyntax  flags
-               .|. TypeLiteralsBit             `setBitIf` xopt Opt_DataKinds flags
                .|. ExplicitNamespacesBit       `setBitIf` xopt Opt_ExplicitNamespaces flags
                .|. LambdaCaseBit               `setBitIf` xopt Opt_LambdaCase               flags
                .|. BinaryLiteralsBit           `setBitIf` xopt Opt_BinaryLiterals           flags
index fcc21e1..e33808d 100644 (file)
@@ -1207,8 +1207,8 @@ atype :: { LHsType RdrName }
 
         | '[' ctype ',' comma_types1 ']'  { LL $ HsExplicitListTy
                                                  placeHolderKind ($2 : $4) }
-        | INTEGER            {% mkTyLit $ LL $ HsNumTy $ getINTEGER $1 }
-        | STRING             {% mkTyLit $ LL $ HsStrTy $ getSTRING  $1 }
+        | INTEGER                         { LL $ HsTyLit $ HsNumTy $ getINTEGER $1 }
+        | STRING                          { LL $ HsTyLit $ HsStrTy $ getSTRING  $1 }
 
 -- An inst_type is what occurs in the head of an instance decl
 --      e.g.  (Foo a, Gaz b) => Wibble a b
index 823be85..6bd5d27 100644 (file)
@@ -20,7 +20,6 @@ module RdrHsSyn (
         splitCon, mkInlinePragma,
         splitPatSyn, toPatSynMatchGroup,
         mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
-        mkTyLit,
         mkTyClD, mkInstD,
 
         cvBindGroup,
@@ -261,15 +260,6 @@ mkSpliceDecl lexpr@(L loc expr)
   where
     splice = mkHsSplice lexpr
 
-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
                 -> [Located (Maybe FastString)]      -- roles
@@ -430,7 +420,7 @@ splitCon ty
                                         return (data_con, mk_rest ts)
    split (L l (HsTupleTy _ [])) [] = return (L l (getRdrName unitDataCon), PrefixCon [])
                                          -- See Note [Unit tuples] in HsTypes
-   split (L l _) _                 = parseErrorSDoc l (text "parse error in constructor in data/newtype declaration:" <+> ppr ty)
+   split (L l _) _                 = parseErrorSDoc l (text "Cannot parse data constructor in a data/newtype declaration:" <+> ppr ty)
 
    mk_rest [L _ (HsRecTy flds)] = RecCon flds
    mk_rest ts                   = PrefixCon ts
index c719191..38985a4 100644 (file)
@@ -257,11 +257,10 @@ rnHsTyKi isType doc tupleTy@(HsTupleTy tup_con tys)
        ; (tys', fvs) <- mapFvRn (rnLHsTyKi isType doc) tys
        ; return (HsTupleTy tup_con tys', fvs) }
 
--- 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))
+       ; unless data_kinds (addErr (dataKindsErr isType tyLit))
        ; when (negLit t) (addErr negLitErr)
        ; return (HsTyLit t, emptyFVs) }
   where
index 342354d..e2360b2 100644 (file)
@@ -1,3 +1,3 @@
 
 T3811b.hs:4:14:
-    parse error in constructor in data/newtype declaration: !B
+    Cannot parse data constructor in a data/newtype declaration: !B
diff --git a/testsuite/tests/typecheck/should_fail/T9634.hs b/testsuite/tests/typecheck/should_fail/T9634.hs
new file mode 100644 (file)
index 0000000..57dea22
--- /dev/null
@@ -0,0 +1,3 @@
+module T9634 where
+
+data X = 1
diff --git a/testsuite/tests/typecheck/should_fail/T9634.stderr b/testsuite/tests/typecheck/should_fail/T9634.stderr
new file mode 100644 (file)
index 0000000..1a2ed05
--- /dev/null
@@ -0,0 +1,3 @@
+
+T9634.hs:3:10:
+    Cannot parse data constructor in a data/newtype declaration: 1
index 431a9ba..960b5c3 100644 (file)
@@ -335,3 +335,4 @@ test('T9305', normal, compile_fail, [''])
 test('T9323', normal, compile_fail, [''])
 test('T9415', normal, compile_fail, [''])
 test('T9612', normal, compile_fail, [''])
+test('T9634', normal, compile_fail, [''])
index c38674b..d3f5e76 100644 (file)
@@ -1,3 +1,3 @@
 
 tcfail094.hs:7:14:
-    Illegal literal in type (use DataKinds to enable): 1
+    Illegal type: ‘1’ Perhaps you intended to use DataKinds