From a886e1222a7649441ec7511ad41e71ca0df91ced Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sun, 15 Jun 2008 00:00:41 +0000 Subject: [PATCH] Allow -X flags to be deprecated, and deprecate RecordPuns; fixes #2320 --- compiler/ghci/InteractiveUI.hs | 6 +- compiler/main/DynFlags.hs | 146 +++++++++++++++++++++------------------- 2 files changed, 81 insertions(+), 71 deletions(-) diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index 994c0e1..cacbce2 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -1411,8 +1411,8 @@ setCmd "" | otherwise = text " " <> text "-fno-" <> text str (ghciFlags,others) = partition (\(_,f)->f `elem` flags) DynFlags.fFlags - nonLanguageDynFlags = filter (\(_,f)->not $ f `elem` map snd xFlags) - others + nonLanguageDynFlags = filterOut (\(_,f) -> f `elem` languageOptions) + others flags = [Opt_PrintExplicitForalls ,Opt_PrintBindResult ,Opt_BreakOnException @@ -1648,7 +1648,7 @@ showLanguages = do dflags <- getDynFlags io $ putStrLn $ showSDoc $ vcat $ text "active language flags:" : - [text (" -X" ++ str) | (str,f) <- DynFlags.xFlags, dopt f dflags] + [text (" -X" ++ str) | (str, f, _) <- DynFlags.xFlags, dopt f dflags] -- ----------------------------------------------------------------------------- -- Completion diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index f501a6b..bc04969 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -49,7 +49,7 @@ module DynFlags ( -- misc stuff machdepCCOpts, picCCOpts, - supportedLanguages, + supportedLanguages, languageOptions, compilerInfo, ) where @@ -1011,12 +1011,11 @@ allFlags = map ('-':) $ [ flagName flag | flag <- dynamic_flags, ok (flagOptKind flag) ] ++ map ("fno-"++) flags ++ map ("f"++) flags ++ - map ("X"++) xs ++ - map ("XNo"++) xs + map ("X"++) supportedLanguages ++ + map ("XNo"++) supportedLanguages where ok (PrefixPred _ _) = False ok _ = True flags = map fst fFlags - xs = map fst xFlags dynamic_flags :: [Flag DynP] dynamic_flags = [ @@ -1349,17 +1348,22 @@ dynamic_flags = [ (PrefixPred (isPrefFlag "no-" fFlags) (\f -> unSetDynFlag (getPrefFlag "no-" fFlags f))) Supported - - -- the -X* and -XNo* flags - , Flag "X" - (PrefixPred (isFlag xFlags) - (\f -> setDynFlag (getFlag xFlags f))) - Supported - , Flag "X" - (PrefixPred (isPrefFlag "No" xFlags) - (\f -> unSetDynFlag (getPrefFlag "No" xFlags f))) - Supported ] + ++ -- -X* + map xFlagToFlag xFlags + ++ -- -XNo* + map xNoFlagToFlag xFlags + +xFlagToFlag :: (String, DynFlag, Deprecated) -> Flag DynP +xFlagToFlag = xMaybeFlagToFlag setDynFlag + +xNoFlagToFlag :: (String, DynFlag, Deprecated) -> Flag DynP +xNoFlagToFlag = xMaybeFlagToFlag unSetDynFlag + +xMaybeFlagToFlag :: (DynFlag -> DynP ()) -> (String, DynFlag, Deprecated) + -> Flag DynP +xMaybeFlagToFlag f (name, dynflag, deprecated) + = Flag ('X' : name) (NoArg (f dynflag)) deprecated -- these -f flags can all be reversed with -fno- @@ -1453,66 +1457,72 @@ fFlags = [ ] supportedLanguages :: [String] -supportedLanguages = map fst xFlags +supportedLanguages = [ name | (name, _, _) <- xFlags ] + +-- This may contain duplicates +languageOptions :: [DynFlag] +languageOptions = [ dynFlag | (_, dynFlag, _) <- xFlags ] -- These -X flags can all be reversed with -XNo -xFlags :: [(String, DynFlag)] +xFlags :: [(String, DynFlag, Deprecated)] xFlags = [ - ( "CPP", Opt_Cpp ), - ( "PatternGuards", Opt_PatternGuards ), - ( "UnicodeSyntax", Opt_UnicodeSyntax ), - ( "MagicHash", Opt_MagicHash ), - ( "PolymorphicComponents", Opt_PolymorphicComponents ), - ( "ExistentialQuantification", Opt_ExistentialQuantification ), - ( "KindSignatures", Opt_KindSignatures ), - ( "PatternSignatures", Opt_PatternSignatures ), - ( "EmptyDataDecls", Opt_EmptyDataDecls ), - ( "ParallelListComp", Opt_ParallelListComp ), - ( "TransformListComp", Opt_TransformListComp ), - ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface ), - ( "UnliftedFFITypes", Opt_UnliftedFFITypes ), - ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms ), - ( "Rank2Types", Opt_Rank2Types ), - ( "RankNTypes", Opt_RankNTypes ), - ( "ImpredicativeTypes", Opt_ImpredicativeTypes ), - ( "TypeOperators", Opt_TypeOperators ), - ( "RecursiveDo", Opt_RecursiveDo ), - ( "Arrows", Opt_Arrows ), - ( "PArr", Opt_PArr ), - ( "TemplateHaskell", Opt_TemplateHaskell ), - ( "QuasiQuotes", Opt_QuasiQuotes ), - ( "Generics", Opt_Generics ), + ( "CPP", Opt_Cpp, Supported ), + ( "PatternGuards", Opt_PatternGuards, Supported ), + ( "UnicodeSyntax", Opt_UnicodeSyntax, Supported ), + ( "MagicHash", Opt_MagicHash, Supported ), + ( "PolymorphicComponents", Opt_PolymorphicComponents, Supported ), + ( "ExistentialQuantification", Opt_ExistentialQuantification, Supported ), + ( "KindSignatures", Opt_KindSignatures, Supported ), + ( "PatternSignatures", Opt_PatternSignatures, Supported ), + ( "EmptyDataDecls", Opt_EmptyDataDecls, Supported ), + ( "ParallelListComp", Opt_ParallelListComp, Supported ), + ( "TransformListComp", Opt_TransformListComp, Supported ), + ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface, Supported ), + ( "UnliftedFFITypes", Opt_UnliftedFFITypes, Supported ), + ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, Supported ), + ( "Rank2Types", Opt_Rank2Types, Supported ), + ( "RankNTypes", Opt_RankNTypes, Supported ), + ( "ImpredicativeTypes", Opt_ImpredicativeTypes, Supported ), + ( "TypeOperators", Opt_TypeOperators, Supported ), + ( "RecursiveDo", Opt_RecursiveDo, Supported ), + ( "Arrows", Opt_Arrows, Supported ), + ( "PArr", Opt_PArr, Supported ), + ( "TemplateHaskell", Opt_TemplateHaskell, Supported ), + ( "QuasiQuotes", Opt_QuasiQuotes, Supported ), + ( "Generics", Opt_Generics, Supported ), -- On by default: - ( "ImplicitPrelude", Opt_ImplicitPrelude ), - ( "RecordWildCards", Opt_RecordWildCards ), - ( "RecordPuns", Opt_RecordPuns ), - ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields ), - ( "OverloadedStrings", Opt_OverloadedStrings ), - ( "GADTs", Opt_GADTs ), - ( "ViewPatterns", Opt_ViewPatterns), - ( "TypeFamilies", Opt_TypeFamilies ), - ( "BangPatterns", Opt_BangPatterns ), + ( "ImplicitPrelude", Opt_ImplicitPrelude, Supported ), + ( "RecordWildCards", Opt_RecordWildCards, Supported ), + ( "NamedFieldPuns", Opt_RecordPuns, Supported ), + ( "RecordPuns", Opt_RecordPuns, + Deprecated "Use the NamedFieldPuns language instead" ), + ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields, Supported ), + ( "OverloadedStrings", Opt_OverloadedStrings, Supported ), + ( "GADTs", Opt_GADTs, Supported ), + ( "ViewPatterns", Opt_ViewPatterns, Supported ), + ( "TypeFamilies", Opt_TypeFamilies, Supported ), + ( "BangPatterns", Opt_BangPatterns, Supported ), -- On by default: - ( "MonomorphismRestriction", Opt_MonomorphismRestriction ), + ( "MonomorphismRestriction", Opt_MonomorphismRestriction, Supported ), -- On by default (which is not strictly H98): - ( "MonoPatBinds", Opt_MonoPatBinds ), - ( "RelaxedPolyRec", Opt_RelaxedPolyRec), - ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules ), - ( "ImplicitParams", Opt_ImplicitParams ), - ( "ScopedTypeVariables", Opt_ScopedTypeVariables ), - ( "UnboxedTuples", Opt_UnboxedTuples ), - ( "StandaloneDeriving", Opt_StandaloneDeriving ), - ( "DeriveDataTypeable", Opt_DeriveDataTypeable ), - ( "TypeSynonymInstances", Opt_TypeSynonymInstances ), - ( "FlexibleContexts", Opt_FlexibleContexts ), - ( "FlexibleInstances", Opt_FlexibleInstances ), - ( "ConstrainedClassMethods", Opt_ConstrainedClassMethods ), - ( "MultiParamTypeClasses", Opt_MultiParamTypeClasses ), - ( "FunctionalDependencies", Opt_FunctionalDependencies ), - ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving ), - ( "OverlappingInstances", Opt_OverlappingInstances ), - ( "UndecidableInstances", Opt_UndecidableInstances ), - ( "IncoherentInstances", Opt_IncoherentInstances ) + ( "MonoPatBinds", Opt_MonoPatBinds, Supported ), + ( "RelaxedPolyRec", Opt_RelaxedPolyRec, Supported ), + ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, Supported ), + ( "ImplicitParams", Opt_ImplicitParams, Supported ), + ( "ScopedTypeVariables", Opt_ScopedTypeVariables, Supported ), + ( "UnboxedTuples", Opt_UnboxedTuples, Supported ), + ( "StandaloneDeriving", Opt_StandaloneDeriving, Supported ), + ( "DeriveDataTypeable", Opt_DeriveDataTypeable, Supported ), + ( "TypeSynonymInstances", Opt_TypeSynonymInstances, Supported ), + ( "FlexibleContexts", Opt_FlexibleContexts, Supported ), + ( "FlexibleInstances", Opt_FlexibleInstances, Supported ), + ( "ConstrainedClassMethods", Opt_ConstrainedClassMethods, Supported ), + ( "MultiParamTypeClasses", Opt_MultiParamTypeClasses, Supported ), + ( "FunctionalDependencies", Opt_FunctionalDependencies, Supported ), + ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving, Supported ), + ( "OverlappingInstances", Opt_OverlappingInstances, Supported ), + ( "UndecidableInstances", Opt_UndecidableInstances, Supported ), + ( "IncoherentInstances", Opt_IncoherentInstances, Supported ) ] impliedFlags :: [(DynFlag, [DynFlag])] -- 1.7.10.4