Option -findexed-types

Mon Sep 18 19:42:48 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
  * Option -findexed-types
  Fri Sep  8 21:35:37 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
    * 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).

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 0a361a4..318df02 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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