From b0e7c6f2d78e856761944c27755b442e36ead60f Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Mon, 14 May 2007 11:53:34 +0000 Subject: [PATCH] -findexed-types -> -ftype-families . This change tracks our current terminology. It'll break all programs using the old option, sorry. But this has only been an experimental feature in the HEAD so far. --- compiler/main/DynFlags.hs | 6 +++--- compiler/parser/Lexer.x | 22 +++++++++++----------- compiler/rename/RnNames.lhs | 22 +++++++++++----------- compiler/typecheck/TcMType.lhs | 8 ++++---- compiler/typecheck/TcTyClsDecls.lhs | 18 +++++++++--------- 5 files changed, 38 insertions(+), 38 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 51abf36..872f13b 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -175,7 +175,7 @@ data DynFlag | Opt_ImplicitPrelude | Opt_ScopedTypeVariables | Opt_BangPatterns - | Opt_IndexedTypes + | Opt_TypeFamilies | Opt_OverloadedStrings -- optimisation opts @@ -1051,7 +1051,7 @@ fFlags = [ ( "scoped-type-variables", Opt_ScopedTypeVariables ), ( "bang-patterns", Opt_BangPatterns ), ( "overloaded-strings", Opt_OverloadedStrings ), - ( "indexed-types", Opt_IndexedTypes ), + ( "type-families", Opt_TypeFamilies ), ( "monomorphism-restriction", Opt_MonomorphismRestriction ), ( "mono-pat-binds", Opt_MonoPatBinds ), ( "extended-default-rules", Opt_ExtendedDefaultRules ), @@ -1088,7 +1088,7 @@ glasgowExtsFlags = [ Opt_FFI, Opt_ImplicitParams, Opt_ScopedTypeVariables, - Opt_IndexedTypes ] + Opt_TypeFamilies ] 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 e9e9c86..b063147 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -597,7 +597,7 @@ reservedWordsFM = listToUFM $ ( "forall", ITforall, bit tvBit), ( "mdo", ITmdo, bit glaExtsBit), - ( "family", ITfamily, bit idxTysBit), + ( "family", ITfamily, bit tyFamBit), ( "foreign", ITforeign, bit ffiBit), ( "export", ITexport, bit ffiBit), @@ -632,7 +632,7 @@ reservedSymsFM = listToUFM $ ,("!", ITbang, 0) ,("*", ITstar, bit glaExtsBit .|. - bit idxTysBit) -- For data T (a::*) = MkT + bit tyFamBit) -- For data T (a::*) = MkT ,(".", ITdot, bit tvBit) -- For 'forall a . t' ,("-<", ITlarrowtail, bit arrowsBit) @@ -1495,7 +1495,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 +tyFamBit = 9 -- indexed type families: 'family' keyword and kind sigs haddockBit = 10 -- Lex and parse Haddock comments glaExtsEnabled, ffiEnabled, parrEnabled :: Int -> Bool @@ -1507,7 +1507,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 +tyFamEnabled flags = testBit flags tyFamBit haddockEnabled flags = testBit flags haddockBit -- PState for parsing options pragmas @@ -1550,16 +1550,16 @@ mkPState buf loc flags = -- we begin in the layout state if toplev_layout is set } where - bitmap = glaExtsBit `setBitIf` dopt Opt_GlasgowExts flags - .|. ffiBit `setBitIf` dopt Opt_FFI flags - .|. parrBit `setBitIf` dopt Opt_PArr flags - .|. arrowsBit `setBitIf` dopt Opt_Arrows flags - .|. thBit `setBitIf` dopt Opt_TH flags + bitmap = glaExtsBit `setBitIf` dopt Opt_GlasgowExts flags + .|. ffiBit `setBitIf` dopt Opt_FFI flags + .|. parrBit `setBitIf` dopt Opt_PArr flags + .|. arrowsBit `setBitIf` dopt Opt_Arrows flags + .|. thBit `setBitIf` dopt Opt_TH 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 - .|. haddockBit `setBitIf` dopt Opt_Haddock flags + .|. tyFamBit `setBitIf` dopt Opt_TypeFamilies flags + .|. haddockBit `setBitIf` dopt Opt_Haddock flags -- setBitIf :: Int -> Bool -> Int b `setBitIf` cond | cond = bit b diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 4a880ed..7f80049 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -302,7 +302,7 @@ used for source code. *** See "THE NAMING STORY" in HsDecls **** -Instances of indexed types +Instances of type families ~~~~~~~~~~~~~~~~~~~~~~~~~~ Indexed data/newtype instances contain data constructors that we need to collect, too. Moreover, we need to descend into the data/newtypes instances @@ -384,8 +384,8 @@ filterImports iface decl_spec Nothing all_avails filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails = do -- check for errors, convert RdrNames to Names - opt_indexedtypes <- doptM Opt_IndexedTypes - items1 <- mapM (lookup_lie opt_indexedtypes) import_items + opt_typeFamilies <- doptM Opt_TypeFamilies + items1 <- mapM (lookup_lie opt_typeFamilies) import_items let items2 :: [(LIE Name, AvailInfo)] items2 = concat items1 @@ -432,10 +432,10 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails (name, AvailTC name subs, Just parent) lookup_lie :: Bool -> LIE RdrName -> TcRn [(LIE Name, AvailInfo)] - lookup_lie opt_indexedtypes (L loc ieRdr) + lookup_lie opt_typeFamilies (L loc ieRdr) = do stuff <- setSrcSpan loc $ - case lookup_ie opt_indexedtypes ieRdr of + case lookup_ie opt_typeFamilies ieRdr of Failed err -> addErr err >> return [] Succeeded a -> return a checkDodgyImport stuff @@ -460,7 +460,7 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails -- AvailInfos for the data constructors and the family (as they have -- different parents). See the discussion at occ_env. lookup_ie :: Bool -> IE RdrName -> MaybeErr Message [(IE Name,AvailInfo)] - lookup_ie opt_indexedtypes ie + lookup_ie opt_typeFamilies ie = let bad_ie = Failed (badImportItemErr iface decl_spec ie) lookup_name rdrName = @@ -505,8 +505,8 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails children <- if any isNothing mb_children then bad_ie else return (catMaybes mb_children) - -- check for proper import of indexed types - when (not opt_indexedtypes && any isTyConName children) $ + -- check for proper import of type families + when (not opt_typeFamilies && any isTyConName children) $ Failed (typeItemErr (head . filter isTyConName $ children) (text "in import list")) case mb_parent of @@ -837,8 +837,8 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod then do addErr (exportItemErr ie) return (IEThingWith name [], AvailTC name [name]) else do let names = catMaybes mb_names - optIdxTypes <- doptM Opt_IndexedTypes - when (not optIdxTypes && any isTyConName names) $ + optTyFam <- doptM Opt_TypeFamilies + when (not optTyFam && any isTyConName names) $ addErr (typeItemErr ( head . filter isTyConName $ names ) @@ -1309,7 +1309,7 @@ exportItemErr export_item typeItemErr name wherestr = sep [ ptext SLIT("Using 'type' tag on") <+> quotes (ppr name) <+> wherestr, - ptext SLIT("Use -findexed-types to enable this extension") ] + ptext SLIT("Use -ftype-families to enable this extension") ] exportClashErr :: GlobalRdrEnv -> Name -> Name -> IE RdrName -> IE RdrName -> Message diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs index 6e72536..87e2d94 100644 --- a/compiler/typecheck/TcMType.lhs +++ b/compiler/typecheck/TcMType.lhs @@ -943,9 +943,9 @@ check_pred_ty dflags ctxt pred@(ClassP cls tys) how_to_allow = parens (ptext SLIT("Use -fglasgow-exts to permit this")) check_pred_ty dflags ctxt pred@(EqPred ty1 ty2) - = do { -- Equational constraints are valid in all contexts if indexed - -- types are permitted - ; checkTc (dopt Opt_IndexedTypes dflags) (eqPredTyErr pred) + = do { -- Equational constraints are valid in all contexts if type + -- families are permitted + ; checkTc (dopt Opt_TypeFamilies dflags) (eqPredTyErr pred) -- Check the form of the argument types ; check_eq_arg_type ty1 @@ -1075,7 +1075,7 @@ checkThetaCtxt ctxt theta badPredTyErr sty = ptext SLIT("Illegal constraint") <+> pprPred sty eqPredTyErr sty = ptext SLIT("Illegal equational constraint") <+> pprPred sty $$ - parens (ptext SLIT("Use -findexed-types to permit this")) + parens (ptext SLIT("Use -ftype-families to permit this")) predTyVarErr pred = sep [ptext SLIT("Non type-variable argument"), nest 2 (ptext SLIT("in the constraint:") <+> pprPred pred)] dupPredWarn dups = ptext SLIT("Duplicate constraint(s):") <+> pprWithCommas pprPred (map head dups) diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 50e0f4c..ae90ef8 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -133,7 +133,7 @@ tcTyAndClassDecls :: ModDetails -> [LTyClDecl Name] -> TcM TcGblEnv -- Input env extended by types and classes -- and their implicit Ids,DataCons tcTyAndClassDecls boot_details allDecls - = do { -- Omit instances of indexed types; they are handled together + = do { -- Omit instances of type families; they are handled together -- with the *heads* of class instances ; let decls = filter (not . isFamInstDecl . unLoc) allDecls @@ -239,9 +239,9 @@ tcFamInstDecl (L loc decl) recoverM (returnM Nothing) $ setSrcSpan loc $ tcAddDeclCtxt decl $ - do { -- type families require -findexed-types and can't be in an + do { -- type families require -ftype-families and can't be in an -- hs-boot file - ; gla_exts <- doptM Opt_IndexedTypes + ; gla_exts <- doptM Opt_TypeFamilies ; is_boot <- tcIsHsBoot -- Are we compiling an hs-boot file? ; checkTc gla_exts $ badFamInstDecl (tcdLName decl) ; checkTc (not is_boot) $ badBootFamInstDeclErr @@ -392,7 +392,7 @@ So we must infer their kinds from their right-hand sides *first* and then use them, whereas for the mutually recursive data types D we bring into scope kind bindings D -> k, where k is a kind variable, and do inference. -Indexed Types +Type families ~~~~~~~~~~~~~ This treatment of type synonyms only applies to Haskell 98-style synonyms. General type functions can be recursive, and hence, appear in `alg_decls'. @@ -618,9 +618,9 @@ tcTyClDecl1 _calc_isrec -- kind checking = tcTyVarBndrs tvs $ \ tvs' -> do { traceTc (text "type family: " <+> ppr tc_name) - ; idx_tys <- doptM Opt_IndexedTypes + ; idx_tys <- doptM Opt_TypeFamilies - -- Check that we don't use families without -findexed-types + -- Check that we don't use families without -ftype-families ; checkTc idx_tys $ badFamInstDecl tc_name ; tycon <- buildSynTyCon tc_name tvs' (OpenSynTyCon kind Nothing) Nothing @@ -636,9 +636,9 @@ tcTyClDecl1 _calc_isrec ; extra_tvs <- tcDataKindSig mb_kind ; let final_tvs = tvs' ++ extra_tvs -- we may not need these - ; idx_tys <- doptM Opt_IndexedTypes + ; idx_tys <- doptM Opt_TypeFamilies - -- Check that we don't use families without -findexed-types + -- Check that we don't use families without -ftype-families ; checkTc idx_tys $ badFamInstDecl tc_name ; tycon <- buildAlgTyCon tc_name final_tvs [] @@ -1168,7 +1168,7 @@ badSigTyDecl tc_name badFamInstDecl tc_name = vcat [ ptext SLIT("Illegal family instance for") <+> quotes (ppr tc_name) - , nest 2 (parens $ ptext SLIT("Use -findexed-types to allow indexed type families")) ] + , nest 2 (parens $ ptext SLIT("Use -ftype-families to allow indexed type families")) ] badGadtIdxTyDecl tc_name = vcat [ ptext SLIT("Illegal generalised algebraic data declaration for") <+> -- 1.7.10.4