Commit 284d83ee authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.

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).
parent 0cb269be
......@@ -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)
......
......@@ -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
......
......@@ -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
......
Markdown is supported
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