From c0cc5433a24d5b30de7d6ec6e03480dc9a0958e1 Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Sun, 8 Jul 2007 12:05:53 +0000
Subject: [PATCH] Implement -XKindSignatures
---
compiler/main/DynFlags.hs | 3 +++
compiler/parser/Lexer.x | 5 ++++-
compiler/typecheck/TcTyClsDecls.lhs | 5 +++--
3 files changed, 10 insertions(+), 3 deletions(-)
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 1d19f8e9ffa..cd373f9034a 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -185,6 +185,7 @@ data DynFlag
| Opt_RelaxedPolyRec -- -X=RelaxedPolyRec
| Opt_MagicHash
| Opt_EmptyDataDecls
+ | Opt_KindSignatures
-- optimisation opts
| Opt_Strictness
@@ -1095,6 +1096,7 @@ fFlags = [
xFlags :: [(String, DynFlag)]
xFlags = [
( "MagicHash", Opt_MagicHash ),
+ ( "KindSignatures", Opt_KindSignatures ),
( "EmptyDataDecls", Opt_EmptyDataDecls ),
( "FI", Opt_FFI ), -- support `-ffi'...
( "FFI", Opt_FFI ), -- ...and also `-fffi'
@@ -1141,6 +1143,7 @@ glasgowExtsFlags = [ Opt_GlasgowExts
, Opt_ScopedTypeVariables
, Opt_MagicHash
, Opt_EmptyDataDecls
+ , Opt_KindSignatures
, Opt_TypeFamilies ]
------------------
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index d1a9bb731cc..e008456e7a4 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -649,7 +649,7 @@ reservedSymsFM = listToUFM $
,("-", ITminus, 0)
,("!", ITbang, 0)
- ,("*", ITstar, bit glaExtsBit .|.
+ ,("*", ITstar, bit glaExtsBit .|. bit kindSigsBit .|.
bit tyFamBit) -- For data T (a::*) = MkT
,(".", ITdot, bit tvBit) -- For 'forall a . t'
@@ -1518,6 +1518,7 @@ bangPatBit = 8 -- Tells the parser to understand bang-patterns
tyFamBit = 9 -- indexed type families: 'family' keyword and kind sigs
haddockBit = 10 -- Lex and parse Haddock comments
magicHashBit = 11 -- # in both functions and operators
+kindSigsBit = 12 -- # in both functions and operators
glaExtsEnabled, ffiEnabled, parrEnabled :: Int -> Bool
glaExtsEnabled flags = testBit flags glaExtsBit
@@ -1531,6 +1532,7 @@ bangPatEnabled flags = testBit flags bangPatBit
tyFamEnabled flags = testBit flags tyFamBit
haddockEnabled flags = testBit flags haddockBit
magicHashEnabled flags = testBit flags magicHashBit
+kindSigsEnabled flags = testBit flags kindSigsBit
-- PState for parsing options pragmas
--
@@ -1583,6 +1585,7 @@ mkPState buf loc flags =
.|. tyFamBit `setBitIf` dopt Opt_TypeFamilies flags
.|. haddockBit `setBitIf` dopt Opt_Haddock flags
.|. magicHashBit `setBitIf` dopt Opt_MagicHash flags
+ .|. kindSigsBit `setBitIf` dopt Opt_KindSignatures flags
--
setBitIf :: Int -> Bool -> Int
b `setBitIf` cond | cond = bit b
diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index 9c4b5b20d8a..b942ec2ab35 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -695,6 +695,7 @@ tcTyClDecl1 calc_isrec
; unbox_strict <- doptM Opt_UnboxStrictFields
; gla_exts <- doptM Opt_GlasgowExts
; empty_data_decls <- doptM Opt_EmptyDataDecls
+ ; kind_signatures <- doptM Opt_KindSignatures
; gadt_ok <- doptM Opt_GADTs
; is_boot <- tcIsHsBoot -- Are we compiling an hs-boot file?
@@ -702,7 +703,7 @@ tcTyClDecl1 calc_isrec
; checkTc (gadt_ok || h98_syntax) (badGadtDecl tc_name)
-- Check that we don't use kind signatures without Glasgow extensions
- ; checkTc (gla_exts || isNothing mb_ksig) (badSigTyDecl tc_name)
+ ; checkTc (kind_signatures || isNothing mb_ksig) (badSigTyDecl tc_name)
-- Check that the stupid theta is empty for a GADT-style declaration
; checkTc (null stupid_theta || h98_syntax) (badStupidTheta tc_name)
@@ -1209,7 +1210,7 @@ newtypeFieldErr con_name n_flds
badSigTyDecl tc_name
= vcat [ ptext SLIT("Illegal kind signature") <+>
quotes (ppr tc_name)
- , nest 2 (parens $ ptext SLIT("Use -fglasgow-exts to allow kind signatures")) ]
+ , nest 2 (parens $ ptext SLIT("Use -XKindSignatures to allow kind signatures")) ]
badFamInstDecl tc_name
= vcat [ ptext SLIT("Illegal family instance for") <+>
--
GitLab