From c0cc5433a24d5b30de7d6ec6e03480dc9a0958e1 Mon Sep 17 00:00:00 2001 From: Ian Lynagh 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 1d19f8e..cd373f9 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 d1a9bb7..e008456 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 9c4b5b2..b942ec2 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") <+> -- 1.7.10.4