From 284d83ee6ff1f817d4f7b72f84887f292d96660a Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Wed, 20 Sep 2006 18:48:42 +0000 Subject: [PATCH] Option -findexed-types Mon Sep 18 19:42:48 EDT 2006 Manuel M T Chakravarty * Option -findexed-types Fri Sep 8 21:35:37 EDT 2006 Manuel M T Chakravarty * Option -findexed-types - Introduced the switch -findexed-types to activate the indexed type family framework. - The switch enables the special 'family' and allows kind signatures (which are currently compulsory for associated families). --- compiler/main/DynFlags.hs | 5 ++++- compiler/parser/Lexer.x | 11 +++++++---- compiler/typecheck/TcTyClsDecls.lhs | 10 +++++----- 3 files changed, 16 insertions(+), 10 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 0a361a4..318df02 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -167,6 +167,7 @@ data DynFlag | Opt_ImplicitPrelude | Opt_ScopedTypeVariables | Opt_BangPatterns + | Opt_IndexedTypes -- optimisation opts | Opt_Strictness @@ -1014,6 +1015,7 @@ fFlags = [ ( "implicit-prelude", Opt_ImplicitPrelude ), ( "scoped-type-variables", Opt_ScopedTypeVariables ), ( "bang-patterns", Opt_BangPatterns ), + ( "indexed-types", Opt_IndexedTypes ), ( "monomorphism-restriction", Opt_MonomorphismRestriction ), ( "mono-pat-binds", Opt_MonoPatBinds ), ( "extended-default-rules", Opt_ExtendedDefaultRules ), @@ -1042,7 +1044,8 @@ glasgowExtsFlags = [ Opt_GlasgowExts, Opt_FFI, Opt_ImplicitParams, - Opt_ScopedTypeVariables ] + Opt_ScopedTypeVariables, + Opt_IndexedTypes ] isFFlag f = f `elem` (map fst fFlags) getFFlag f = fromJust (lookup f fFlags) diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index fdbaeef..bc11340 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -543,8 +543,7 @@ reservedWordsFM = listToUFM $ ( "forall", ITforall, bit tvBit), ( "mdo", ITmdo, bit glaExtsBit), - ( "iso", ITiso, bit glaExtsBit), - ( "family", ITfamily, bit glaExtsBit), + ( "family", ITfamily, bit idxTysBit), ( "foreign", ITforeign, bit ffiBit), ( "export", ITexport, bit ffiBit), @@ -578,8 +577,9 @@ reservedSymsFM = listToUFM $ ,("-", ITminus, 0) ,("!", ITbang, 0) - ,("*", ITstar, bit glaExtsBit) -- For data T (a::*) = MkT - ,(".", ITdot, bit tvBit) -- For 'forall a . t' + ,("*", ITstar, bit glaExtsBit .|. + bit idxTysBit) -- For data T (a::*) = MkT + ,(".", ITdot, bit tvBit) -- For 'forall a . t' ,("-<", ITlarrowtail, bit arrowsBit) ,(">-", ITrarrowtail, bit arrowsBit) @@ -1314,6 +1314,7 @@ ipBit = 6 tvBit = 7 -- Scoped type variables enables 'forall' keyword bangPatBit = 8 -- Tells the parser to understand bang-patterns -- (doesn't affect the lexer) +idxTysBit = 9 -- indexed type families: 'family' keyword and kind sigs glaExtsEnabled, ffiEnabled, parrEnabled :: Int -> Bool glaExtsEnabled flags = testBit flags glaExtsBit @@ -1324,6 +1325,7 @@ thEnabled flags = testBit flags thBit ipEnabled flags = testBit flags ipBit tvEnabled flags = testBit flags tvBit bangPatEnabled flags = testBit flags bangPatBit +idxTysEnabled flags = testBit flags idxTysBit -- PState for parsing options pragmas -- @@ -1365,6 +1367,7 @@ mkPState buf loc flags = .|. ipBit `setBitIf` dopt Opt_ImplicitParams flags .|. tvBit `setBitIf` dopt Opt_ScopedTypeVariables flags .|. bangPatBit `setBitIf` dopt Opt_BangPatterns flags + .|. idxTysBit `setBitIf` dopt Opt_IndexedTypes flags -- setBitIf :: Int -> Bool -> Int b `setBitIf` cond | cond = bit b diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index ce2846d..737cd63 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -72,7 +72,7 @@ import SrcLoc ( Located(..), unLoc, getLoc, srcLocSpan, import ListSetOps ( equivClasses, minusList ) import Digraph ( SCC(..) ) import DynFlags ( DynFlag( Opt_GlasgowExts, Opt_Generics, - Opt_UnboxStrictFields ) ) + Opt_UnboxStrictFields, Opt_IndexedTypes ) ) \end{code} @@ -266,9 +266,9 @@ tcIdxTyInstDecl (L loc decl) recoverM (returnM (Nothing, Nothing)) $ setSrcSpan loc $ tcAddDeclCtxt decl $ - do { -- indexed data types require -fglasgow-exts and can't be in an + do { -- indexed data types require -findexed-types and can't be in an -- hs-boot file - ; gla_exts <- doptM Opt_GlasgowExts + ; gla_exts <- doptM Opt_IndexedTypes ; is_boot <- tcIsHsBoot -- Are we compiling an hs-boot file? ; checkTc gla_exts $ badIdxTyDecl (tcdLName decl) ; checkTc (not is_boot) $ badBootTyIdxDeclErr @@ -635,7 +635,7 @@ tcTyClDecl1 _calc_isrec (TyFunction {tcdLName = L _ tc_name, tcdTyVars = tvs, tcdKind = kind}) = tcTyVarBndrs tvs $ \ tvs' -> do { traceTc (text "type family: " <+> ppr tc_name) - ; gla_exts <- doptM Opt_GlasgowExts + ; gla_exts <- doptM Opt_IndexedTypes -- Check that we don't use kind signatures without Glasgow extensions ; checkTc gla_exts $ badSigTyDecl tc_name @@ -653,7 +653,7 @@ tcTyClDecl1 _calc_isrec ; let final_tvs = tvs' ++ extra_tvs -- we may not need these ; checkTc (null . unLoc $ ctxt) $ badKindSigCtxt tc_name - ; gla_exts <- doptM Opt_GlasgowExts + ; gla_exts <- doptM Opt_IndexedTypes -- Check that we don't use kind signatures without Glasgow extensions ; checkTc gla_exts $ badSigTyDecl tc_name -- 1.7.10.4