Commit c0cc5433 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Implement -XKindSignatures

parent f4e40607
...@@ -185,6 +185,7 @@ data DynFlag ...@@ -185,6 +185,7 @@ data DynFlag
| Opt_RelaxedPolyRec -- -X=RelaxedPolyRec | Opt_RelaxedPolyRec -- -X=RelaxedPolyRec
| Opt_MagicHash | Opt_MagicHash
| Opt_EmptyDataDecls | Opt_EmptyDataDecls
| Opt_KindSignatures
-- optimisation opts -- optimisation opts
| Opt_Strictness | Opt_Strictness
...@@ -1095,6 +1096,7 @@ fFlags = [ ...@@ -1095,6 +1096,7 @@ fFlags = [
xFlags :: [(String, DynFlag)] xFlags :: [(String, DynFlag)]
xFlags = [ xFlags = [
( "MagicHash", Opt_MagicHash ), ( "MagicHash", Opt_MagicHash ),
( "KindSignatures", Opt_KindSignatures ),
( "EmptyDataDecls", Opt_EmptyDataDecls ), ( "EmptyDataDecls", Opt_EmptyDataDecls ),
( "FI", Opt_FFI ), -- support `-ffi'... ( "FI", Opt_FFI ), -- support `-ffi'...
( "FFI", Opt_FFI ), -- ...and also `-fffi' ( "FFI", Opt_FFI ), -- ...and also `-fffi'
...@@ -1141,6 +1143,7 @@ glasgowExtsFlags = [ Opt_GlasgowExts ...@@ -1141,6 +1143,7 @@ glasgowExtsFlags = [ Opt_GlasgowExts
, Opt_ScopedTypeVariables , Opt_ScopedTypeVariables
, Opt_MagicHash , Opt_MagicHash
, Opt_EmptyDataDecls , Opt_EmptyDataDecls
, Opt_KindSignatures
, Opt_TypeFamilies ] , Opt_TypeFamilies ]
------------------ ------------------
......
...@@ -649,7 +649,7 @@ reservedSymsFM = listToUFM $ ...@@ -649,7 +649,7 @@ reservedSymsFM = listToUFM $
,("-", ITminus, 0) ,("-", ITminus, 0)
,("!", ITbang, 0) ,("!", ITbang, 0)
,("*", ITstar, bit glaExtsBit .|. ,("*", ITstar, bit glaExtsBit .|. bit kindSigsBit .|.
bit tyFamBit) -- For data T (a::*) = MkT bit tyFamBit) -- For data T (a::*) = MkT
,(".", ITdot, bit tvBit) -- For 'forall a . t' ,(".", ITdot, bit tvBit) -- For 'forall a . t'
...@@ -1518,6 +1518,7 @@ bangPatBit = 8 -- Tells the parser to understand bang-patterns ...@@ -1518,6 +1518,7 @@ bangPatBit = 8 -- Tells the parser to understand bang-patterns
tyFamBit = 9 -- indexed type families: 'family' keyword and kind sigs tyFamBit = 9 -- indexed type families: 'family' keyword and kind sigs
haddockBit = 10 -- Lex and parse Haddock comments haddockBit = 10 -- Lex and parse Haddock comments
magicHashBit = 11 -- # in both functions and operators magicHashBit = 11 -- # in both functions and operators
kindSigsBit = 12 -- # in both functions and operators
glaExtsEnabled, ffiEnabled, parrEnabled :: Int -> Bool glaExtsEnabled, ffiEnabled, parrEnabled :: Int -> Bool
glaExtsEnabled flags = testBit flags glaExtsBit glaExtsEnabled flags = testBit flags glaExtsBit
...@@ -1531,6 +1532,7 @@ bangPatEnabled flags = testBit flags bangPatBit ...@@ -1531,6 +1532,7 @@ bangPatEnabled flags = testBit flags bangPatBit
tyFamEnabled flags = testBit flags tyFamBit tyFamEnabled flags = testBit flags tyFamBit
haddockEnabled flags = testBit flags haddockBit haddockEnabled flags = testBit flags haddockBit
magicHashEnabled flags = testBit flags magicHashBit magicHashEnabled flags = testBit flags magicHashBit
kindSigsEnabled flags = testBit flags kindSigsBit
-- PState for parsing options pragmas -- PState for parsing options pragmas
-- --
...@@ -1583,6 +1585,7 @@ mkPState buf loc flags = ...@@ -1583,6 +1585,7 @@ mkPState buf loc flags =
.|. tyFamBit `setBitIf` dopt Opt_TypeFamilies flags .|. tyFamBit `setBitIf` dopt Opt_TypeFamilies flags
.|. haddockBit `setBitIf` dopt Opt_Haddock flags .|. haddockBit `setBitIf` dopt Opt_Haddock flags
.|. magicHashBit `setBitIf` dopt Opt_MagicHash flags .|. magicHashBit `setBitIf` dopt Opt_MagicHash flags
.|. kindSigsBit `setBitIf` dopt Opt_KindSignatures flags
-- --
setBitIf :: Int -> Bool -> Int setBitIf :: Int -> Bool -> Int
b `setBitIf` cond | cond = bit b b `setBitIf` cond | cond = bit b
......
...@@ -695,6 +695,7 @@ tcTyClDecl1 calc_isrec ...@@ -695,6 +695,7 @@ tcTyClDecl1 calc_isrec
; unbox_strict <- doptM Opt_UnboxStrictFields ; unbox_strict <- doptM Opt_UnboxStrictFields
; gla_exts <- doptM Opt_GlasgowExts ; gla_exts <- doptM Opt_GlasgowExts
; empty_data_decls <- doptM Opt_EmptyDataDecls ; empty_data_decls <- doptM Opt_EmptyDataDecls
; kind_signatures <- doptM Opt_KindSignatures
; gadt_ok <- doptM Opt_GADTs ; gadt_ok <- doptM Opt_GADTs
; is_boot <- tcIsHsBoot -- Are we compiling an hs-boot file? ; is_boot <- tcIsHsBoot -- Are we compiling an hs-boot file?
...@@ -702,7 +703,7 @@ tcTyClDecl1 calc_isrec ...@@ -702,7 +703,7 @@ tcTyClDecl1 calc_isrec
; checkTc (gadt_ok || h98_syntax) (badGadtDecl tc_name) ; checkTc (gadt_ok || h98_syntax) (badGadtDecl tc_name)
-- Check that we don't use kind signatures without Glasgow extensions -- 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 -- Check that the stupid theta is empty for a GADT-style declaration
; checkTc (null stupid_theta || h98_syntax) (badStupidTheta tc_name) ; checkTc (null stupid_theta || h98_syntax) (badStupidTheta tc_name)
...@@ -1209,7 +1210,7 @@ newtypeFieldErr con_name n_flds ...@@ -1209,7 +1210,7 @@ newtypeFieldErr con_name n_flds
badSigTyDecl tc_name badSigTyDecl tc_name
= vcat [ ptext SLIT("Illegal kind signature") <+> = vcat [ ptext SLIT("Illegal kind signature") <+>
quotes (ppr tc_name) 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 badFamInstDecl tc_name
= vcat [ ptext SLIT("Illegal family instance for") <+> = vcat [ ptext SLIT("Illegal family instance for") <+>
......
Supports Markdown
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